home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / modula2 / hk_lib / def_mod / strings.mod < prev    next >
Encoding:
Modula Implementation  |  1994-09-22  |  78.2 KB  |  1,960 lines
  1. IMPLEMENTATION MODULE  Strings;
  2.  
  3. (*****************************************************************************)
  4. (* Bei den meisten Prozeduren treten Zuweisungen von Strings auf, die fol-   *)
  5. (* gendes Schema haben:                                                      *)
  6. (* _________________________________________________________________________ *)
  7. (*                                                                           *)
  8. (*                                                                           *)
  9. (*  IF   HIGH(<Quellstring>)  >  HIGH(<Zielstring>)  THEN                    *)
  10. (*    <max.Index> := HIGH(<Quellstring>);                                    *)
  11. (*  ELSE                                                                     *)
  12. (*    <max.Index> := HIGH(<Zielstring>);                                     *)
  13. (*  END;                                                                     *)
  14. (*                                                                           *)
  15. (* <index> := <Anfangswert>;                                                 *)
  16. (*  WHILE (<Index>  <=  <max.Index>) & (<Quellstring>[<Index>] # EOS )  DO   *)
  17. (*    <Zielstring>[<index>] := <Quellstring>[<index>];                       *)
  18. (*    INC(<index>);                                                          *)
  19. (*  END; (* WHILE *)                                                         *)
  20. (*                                                                           *)
  21. (*  IF  <Index> > HIGH(<Quellstring>) OR (<Quellstring>[<Index>] = EOS ) THEN*)
  22. (*    vollst := TRUE;                                                        *)
  23. (*    IF  <index>  <=  HIGH(<Zielstring>)  THEN                              *)
  24. (*       <Zielstring>[<index>] := EOS;                                       *)
  25. (*    END;                                                                   *)
  26. (*  ELSE                                                                     *)
  27. (*    vollst := FALSE;                                                       *)
  28. (*  END; (* IF *)                                                            *)
  29. (*___________________________________________________________________________*)
  30. (*                                                                           *)
  31. (* Als erstes wird festgestellt, welcher String kuerzer ist. Die folgende    *)
  32. (* Zuweisungsschleife laeuft dann nur bis zum hoechsten Index des kuerzeren  *)
  33. (* Strings. Die Laufindex wird dann auf seinen Anfangswert ( meistens Null ) *)
  34. (* gesetzt.                                                                  *)
  35. (*   Dann wird die Zuweisungsschleife solange durchlaufen, bis entweder der  *)
  36. (* maximale Index des kuerzeren Strings ueberschritten ist ( Die Abbruchbe-  *)
  37. (* dingungen werden natuerlich vor der Zuweisung geprueft ),oder das naechste*)
  38. (* Zeichen des Quellstrings das Nullbyte ist ( damit ist auf jeden Fall eine *)
  39. (* vollstaendige Zuweisung erfolgt ).                                        *)
  40. (*   Nach Beendigung der Schleife muss nun noch ueberprueft werden, ob die   *)
  41. (* Zuweisung durch das Ende des Quellstrings abgebrochen wurde ( dann ist die*)
  42. (* Zuweisung vollstaendig ) oder durch das Ende des Zielstrings - dann wurde *)
  43. (* der Quellstring nicht vollstaendig uebertragen                            *)
  44. (*   Ist der Laufindex um eins groesser als der maximale Feldindex des Quell-*)
  45. (* strings ( HIGH( quelle ) ), oder ist das Zeichen des Quellstrings an der  *)
  46. (* Position des Laufindexes das Nullbyte, dann enthaelt der Zielstring den   *)
  47. (* vollstaendigen Quellstring, egal ob das Feld des Zielstrings ebenfalls    *)
  48. (* voellig belegt ist ( dann hatten beide Strings die gleiche Feldgroesse ). *)
  49. (* Wenn der Zielstring aber noch Platz hat, muss sein Ende durch ein Nullbyte*)
  50. (* gekennzeichnet werden. In allen anderen Faellen war die Zuweisung nicht   *)
  51. (* vollstaendig, und der Ausgangsparameter <vollst> teilt die der aufrufenden*)
  52. (* Prozedur durch den Wert  FALSE  mit.                                      *)
  53. (*___________________________________________________________________________*)
  54. (*                                                                           *)
  55. (* Achtung! Aufgrund der Repraesentation von Strings muessen bei einer       *)
  56. (* Schleife ueber die Laenge des Strings immer BEIDE Endebedingungen be-     *)
  57. (* achtet werden, d.h es ist zu pruefen                                      *)
  58. (*                                                                           *)
  59. (*  1. ob der Maximalindex des Strings erreicht ist (<index> <= HIGH( string)*)
  60. (*                                                                           *)
  61. (*  2. ob das Nullbyte, dass das Ende des Strings kennzeichnet, erreicht ist.*)
  62. (*                                                                           *)
  63. (* Das zweite Kriterium alleine reicht nicht aus, falls der String genauso   *)
  64. (* lang wie das Feld ist.                                                    *)
  65. (* __________________________________________________________________________*)
  66. (*                                                                           *)
  67. (* Die Zuweisung der Strings in Assembler sieht im Prinzip folgendermassen   *)
  68. (* aus:                                                                      *)
  69. (*                                                                           *)
  70. (*       moveq    #0, d1           ; Default: vollst := FALSE                *)
  71. (*                                                                           *)
  72. (*  ; zuerst Adressen der Strings in Adressregister laden, denn durch die    *)
  73. (*  ; Adr.art mit Postinkrement lassen sich die Indexvariablen einsparen     *)
  74. (*                                                                           *)
  75. (*       movea.l  quelle(a6), a0   ; ( register  char *quelle ... )          *)
  76. (*       movea.l  ziel(a6), a1     ; ( register  char *ziel  ...  )          *)
  77. (*           :                                                               *)
  78. (*           :                                                               *)
  79. (*                                                                           *)
  80. (*  ; die maximale Laenge der Strings aus HIGH() ermitteln;das ist eine extra*)
  81. (*  ; Konstante, die den maximalen Index des Strings enthaelt und beim Proze-*)
  82. (*  ; duraufruf zusaetzlich zur Adresse des Strings auf dem Stack abgelegt   *)
  83. (*  ; wird; ihr Wert kann vom Compiler schon waehrend der Uebersetzungszeit  *)
  84. (*  ; aus der Stringdeklaration ermittelt werden. Damit die Schleife recht-  *)
  85. (*  ; zeitig abgebrochen werden kann, wird der kleinere Wert genommen        *)
  86. (*                                                                           *)
  87. (*       move.w  QHIGH(a6), d0  ; d0 := MIN( HIGH(quelle), HIGH(ziel) )      *)
  88. (*       cmp.w   ZHIGH(a6), d0  ;                                            *)
  89. (*       bls.s   asgnlp         ;                                            *)
  90. (*       move.w  ZHIGH(a6), d0  ;                                            *)
  91. (*                                                                           *)
  92. (*  ; In der Schleife wird jetzt der String solange zeichenweise zugewiesen  *)
  93. (*  ; bis der maximale Index erreicht ist, oder ein Nullbyte kopiert wurde.  *)
  94. (*  ; Mit dem DBEQ-Befehl lassen sich beide Bedingungen gleichzeitig testen: *)
  95. (*  ; Wurde ein Nullbyte kopiert, ist die Bedingung EQ wahr, und es wird mit *)
  96. (*  ; dem Befehl direkt dahinter fortgefahren; wenn die maximale Anzahl      *)
  97. (*  ; Zeichen kopiert ist ( max. Anzahl = MIN(HIGH(quelle),HIGH(ziel)) + 1 ),*)
  98. (*  ; dann ist das Zaehlregister bei -1 gelandet, und es wird ebenfalls mit  *)
  99. (*  ; dem naechsten Befehl fortgefahren.                                     *)
  100. (*                                                                           *)
  101. (*     asgnlp:                                                               *)
  102. (*       move.b  (a0)+, (a1)+   ; ein Zeichen kopieren                       *)
  103. (*       dbeq    d0, asgnlp     ; B: Quelle noch nicht vollstaendig kopiert  *)
  104. (*                                                                           *)
  105. (*  ; Wurde die Schleife durch die Kopie eines Nullbytes abgebrochen, ist    *)
  106. (*  ; alles erledigt, der Zielstring ist dann auch schon durch ebendieses    *)
  107. (*  ; Nullbyte abgeschlossen.                                                *)
  108. (*                                                                           *)
  109. (*       beq.s   voll           ; Zielstring ist schon mit 0C abgeschlossen  *)
  110. (*                                                                           *)
  111. (*  ; Ansonsten wird aus dem jetzigen Wert des Quell-Adressregisters und der *)
  112. (*  ; Anfangsadresse des Quellstrings die Anzahl kopierter Zeichen ( = Index *)
  113. (*  ; nach Beendigung der Schleife ) berechnet und mit dem maximalen Index   *)
  114. (*  ; verglichen; ist die Anzahl groesser, dann wurde der Quellstring voll-  *)
  115. (*  ; staendig kopiert.                                                      *)
  116. (*                                                                           *)
  117. (*       move.l  a0, d2         ; wird oefter gebraucht                      *)
  118. (*       movea.l quelle(a6), a2 ; a2 := Anzahl kopierter Zeichen( = Index )  *)
  119. (*       sub.l   a2, d2         ;                                            *)
  120. (*       cmp.w   QHIGH(a6), d2  ; Index > HIGH(quelle) ?                     *)
  121. (*       bhi.s   tsteos         ; B: ja, Quelle vollstaendig kopiert         *)
  122. (*                                                                           *)
  123. (*  ; ebenfalls vollstaendig kopiert wurde, falls zwar der Schleifenabbruch  *)
  124. (*  ; durch das Ende des Zielstrings erfolgte aber hinter dem letzten kopier-*)
  125. (*  ; ten Zeichen im Quellstring ein Nullbyte folgt.                         *)
  126. (*                                                                           *)
  127. (*       tst.b   (a0)           ; hinter dem letzten kopierten Zeichen  EOS ?*)
  128. (*       bne.s   ende           ; B: nein, dann Quelle nicht vollst. kopiert *)
  129. (*                                                                           *)
  130. (*  ; Ist der String vollstaendig kopiert, wird noch geprueft, ob der Ziel-  *)
  131. (*  ; string durch ein Nullbyte abgeschlossen werden kann ( muss ).          *)
  132. (*  ;Die geschieht ebenfalls durch den Vergleich der Anzahl kopierter Zeichen*)
  133. (*  ; mit dem maximalen Index des Zielstrings.                               *)
  134. (*                                                                           *)
  135. (*     tsteos:                                                               *)
  136. (*       cmp.w   ZHIGH(a6), d2  ;Ist im Zielstring noch Platz fuer Nullbyte ?*)
  137. (*       bhi.s   voll           ; B: nein, Ziel voll                         *)
  138. (*       clr.b   (a1)           ;                                            *)
  139. (*                                                                           *)
  140. (*     voll:                                                                 *)
  141. (*       moveq   #1, d1                                                      *)
  142. (*                                                                           *)
  143. (*  ; Der Ausgangsparameter wird entsprechend der Vollstaendigkeit der Zuwei-*)
  144. (*  ; sung gesetzt, damit hat sichs dann.                                    *)
  145. (*                                                                           *)
  146. (*     ende:                                                                 *)
  147. (*       movea.l  vollst(a6), a0  ; da <vollst> ein VAR-Parameter ist, erst- *)
  148. (*                                ; mal die Adresse holen...                 *)
  149. (*       move.b   d2, (a0)        ; ...und <vollst> setzen                   *)
  150. (*           :                                                               *)
  151. (*           :                                                               *)
  152. (* __________________________________________________________________________*)
  153. (*                                                                           *)
  154. (* Die Assemblervarianten der Prozeduren sind bei Stringlaengen von 10 bis 20*)
  155. (* Zeichen ungefaehr zwei- bis dreimal schneller als die MODULA-Versionen.   *)
  156. (* Je groesser die Stringlaengen sind, desto groesser wird der Geschwindig-  *)
  157. (* keitsvorteil, da der Verwaltungs-Overhead des Prozeduraufrufes im Ver-    *)
  158. (* haeltnis zur Dauer der Prozedur kleiner wird.                             *)
  159. (* __________________________________________________________________________*)
  160. (*                                                                           *)
  161. (* August '89  Beginn                                                        *)
  162. (* 21-Sep-89 , hk                                                            *)
  163. (*         Erste Version                                                     *)
  164. (* 29-Okt-89 , hk                                                            *)
  165. (*         Aufspaltung in zwei Module (-> "XStrings" )                       *)
  166. (*         Aenderungen hier: Fehler in "Delete" und "RightPos" beseitigt     *)
  167. (*         "Insert" und "LeftString" vereinfacht, "CompareASCII" -> "Compare"*)
  168. (*         "UpperString" -> "UpperCase".                                     *)
  169. (*         Neue Typen: StringChar, String20, String80, String256,            *)
  170. (*         CompareResult-Werte: kleine Anfangsbuchstaben, EOS nicht mehr     *)
  171. (*         importiert, intern definiert, von "Chars" unabhaengig.            *)
  172. (*         Neue Prozeduren: "Equal","CharToString","AssignChar","AppendChar",*)
  173. (*         "InsertChar",DeleteChar"                                          *)
  174. (*         "ILength" entfallen                                               *)
  175. (* 01-Nov-89 , hk                                                            *)
  176. (*         Bereichsfehler ( negative CARD's ) in "InsertChar","LeftPos",     *)
  177. (*         "RightPos"  beseitigt                                             *)
  178. (* 05-Nov-89 , hk                                                            *)
  179. (*         "Length", "Assign", "LeftString", "Concat", "GetChar","AppendChar"*)
  180. (*         in Assembler                                                      *)
  181. (* 24-Nov-89 , hk                                                            *)
  182. (*         Voellige Umstellung der Stringzuweisung, damit "Assign","Concat", *)
  183. (*         "SubString","LeftString","RightString" ,"UpperCase" praktisch neu *)
  184. (*         zu schreiben                                                      *)
  185. (*         "Equal","Compare","AssignChar","UpperCase"                        *)
  186. (*         in Assembler                                                      *)
  187. (* 01-Dez-89 , hk                                                            *)
  188. (*         kleine Fehler in "InsertChar" verbessert, "InsertChar" und        *)
  189. (*         "AppendChar" behandeln Nullbytes korrekt, d.h. sie ignorieren sie.*)
  190. (*         "LeftString","RightString" gemaess neuer Stringzuweisung          *)
  191. (*         "InsertChar","DeleteChar","LeftString",RightString" in Assembler  *)
  192. (* 03-Dez-89 , hk                                                            *)
  193. (*         Fehler in "SubString": Allgemein gilt: Existiert ein Parameter mit*)
  194. (*         einer Positionsangabe,kann der Aufruf von "Length(string)" nicht  *)
  195. (*         durch eine Schleife von <Startposition> bis zum Auftreten eines   *)
  196. (*         Nullbytes oder dem Ueberschreiten des Index der Feldgrenze ersetzt*)
  197. (*         werden, da <Startposition> auch hinter dem Nullbyte aber vor      *)
  198. (*         HIGH(string) liegen kann!                                         *)
  199. (*         "SubString" gemaess neuer Stringzuweisung                         *)
  200. (*         CARDINAL-Ueberlauf in "SubString","Delete","LeftPos" beseitigt    *)
  201. (*         "SubString","Delete" in Assembler                                 *)
  202. (* 07-Feb-90 , hk                                                            *)
  203. (*         Einige Aenderungen von Namen und Parameterreihenfolgen            *)
  204. (*****************************************************************************)
  205.  
  206.  
  207. FROM  SYSTEM  IMPORT (* PROC *)  VAL, INLINE;
  208.  
  209.  
  210. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  211.  
  212. CONST  EOS = 0C;  (* dynamische Endekennung der Strings *)
  213.  
  214. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  215. PROCEDURE t;
  216. BEGIN
  217.        INLINE( 7200H,206EH,0018H,226EH,0010H,302EH,0000H,3400H,4A18H );
  218.        INLINE( 57C8H,0FFFCH,9440H,673AH,302EH,0016H,6734H,0B042H,6302H );
  219.        INLINE( 3002H,3600H,9440H,5340H,0B06EH,0014H,6304H,302EH,0014H );
  220.        INLINE( 206EH,0018H,0D0C2H,12D8H,51C8H,0FFFCH,2409H,246EH,0010H );
  221.        INLINE( 948AH,0B443H,650AH,0B46EH,0014H,6202H,4211H,7201H,206EH );
  222.        INLINE( 000CH,1081H );
  223. END t;
  224.  
  225.  
  226.   PROCEDURE  Length ((* EIN/ -- *) string: ARRAY OF CHAR ): CARDINAL;
  227. (*T*)
  228. (*   VAR  Index : CARDINAL; *)
  229.  
  230.      BEGIN
  231. (*     Index := 0;
  232.        (* Endemarkierung suchen, oder Feldende, falls
  233.         * String Feld ausfuellt.
  234.         *)
  235.        WHILE  ( Index <= VAL( CARDINAL, HIGH( string )))  &
  236.               ( string[ Index ] # EOS                  )
  237.        DO
  238.          (* (0<=Index<=HIGH(string)) & ((0<=i<=Index) => (string[i] # EOS)
  239.           *)
  240.          INC( Index );
  241.        END;
  242.  
  243.        (* ((Index=HIGH(string)+1) OR (string[Index] = EOS)) &
  244.         * ((0<=i<Index) => (string[i] # EOS )             )
  245.         *)
  246.        RETURN( Index );
  247.  
  248.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  249.  
  250.        string  EQU     12        ; letzter Parameter immer mit Offset 12
  251.        HIGH    EQU     string+4
  252.        RETURN  EQU     HIGH+2    ; Platz fuer Funktionswert als erstes auf
  253.                                  ; dem Stack
  254.                                  ; Die Parameter werden beim Prozeduraufruf
  255.                                  ; in der Reihenfolge ihres Auftretens im
  256.                                  ; Programmtext auf den Stack kopiert -
  257.                                  ; umgekehrt wie bei 'C'-Compilern. Ausserdem
  258.                                  ; wird auch ein Funktionswert auf dem Stack
  259.                                  ; uebergeben, nicht in Register D0 wie bei
  260.                                  ; 'C'-Compilern
  261.                                  ; ausserdem liegen die Parameter immer
  262.                                  ; auf geraden Adressen, auch CHAR und BOOLEAN
  263.        Length:
  264.          movea.l string(a6), a0  ; a0 -> lokale Stringvariable
  265.          move.w  HIGH(a6), d0    ; max. Index des Strings
  266.          move.w  d0, d1
  267.        lenlp:
  268.          tst.b   (a0)+           ; dyn. Ende des Strings erreicht  ?
  269.          dbeq    d0, lenlp       ; B: nein, noch nicht
  270.          sub.w   d0, d1          ; Length( string ) = HIGH( string ) - d0
  271.          move.w  d1, RETURN(a6)
  272. *)
  273.        INLINE( 206EH,000CH,302EH,0010H,3200H,4A18H,57C8H,0FFFCH,9240H );
  274.        INLINE( 3D41H,0012H );
  275.  
  276.      END  Length;
  277.  
  278. (* ------------------------------------------------------------------------- *)
  279.  
  280.   PROCEDURE  ClearStr ((* -- /AUS *) VAR string : ARRAY OF CHAR );
  281. (*T*)
  282.      BEGIN
  283.        string[ 0 ] := EOS;
  284.      END  ClearStr;
  285.  
  286. (* ------------------------------------------------------------------------- *)
  287.  
  288.   PROCEDURE  IsEmptyStr ((* EIN/ -- *) string : ARRAY OF CHAR ): BOOLEAN;
  289. (*T*)
  290.      BEGIN
  291.        RETURN( string[ 0 ] = EOS );
  292.      END  IsEmptyStr;
  293.  
  294. (* ------------------------------------------------------------------------- *)
  295.  
  296.   PROCEDURE  Assign ((* EIN/ -- *)     quelle : ARRAY OF CHAR;
  297.                      (* -- /AUS *) VAR ziel   : ARRAY OF CHAR;
  298.                      (* -- /AUS *) VAR vollst : BOOLEAN       );
  299. (*T*)
  300. (*   VAR  Index,
  301.           MaxIndex : CARDINAL; *)
  302.  
  303.      BEGIN
  304. (*     IF  HIGH( quelle )  >  HIGH( ziel )  THEN
  305.           MaxIndex := HIGH( ziel );
  306.        ELSE
  307.           MaxIndex := HIGH( quelle );
  308.        END;
  309.  
  310.        Index := 0;
  311.        WHILE ( Index <= MaxIndex ) & ( quelle[ Index ] # EOS )  DO
  312.  
  313.           (* (0<=Index<=HIGH(quelle)) & (0<=Index<=HIGH(ziel)) &
  314.            * ((0<=i<Index) => (ziel[i]=quelle[i])) &
  315.            * ((0<=i<=Index) => (quelle[i] # EOS))
  316.            *)
  317.           ziel[ Index ] := quelle[ Index ];
  318.           INC( Index );
  319.        END;
  320.  
  321.        (* ((Index=HIGH(ziel)+1) OR (Index=HIGH(quelle)+1) OR
  322.         *  (quelle[Index]=EOS)                               ) &
  323.         * ((0<=i<Index) => (ziel[i]=quelle[i] # EOS )        )
  324.         *)
  325.  
  326.        IF  ( Index > VAL( CARDINAL, HIGH( quelle )))  OR
  327.            ( quelle[ Index ] = EOS                 )
  328.        THEN
  329.           vollst := TRUE;
  330.           IF  Index <= VAL( CARDINAL, HIGH( ziel ))  THEN
  331.              ziel[ Index ] := EOS;
  332.           END;
  333.        ELSE
  334.           vollst := FALSE;
  335.        END;
  336.  
  337.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  338.  
  339.        vollst  EQU  12
  340.        ziel    EQU  vollst + 4
  341.        ZHIGH   EQU  ziel + 4
  342.        quelle  EQU  ZHIGH + 2
  343.        QHIGH   EQU  quelle + 4
  344.  
  345.        Assign:
  346.          moveq   #0, d1
  347.          movea.l quelle(a6), a0 ; a0 -> quelle, lokale Variable
  348.          movea.l ziel(a6), a1   ; a1 -> ziel
  349.          move.w  QHIGH(a6), d0  ; d0 := MIN( HIGH(quelle), HIGH(ziel) )
  350.          cmp.w   ZHIGH(a6), d0  ;
  351.          bls.s   asgnlp         ;
  352.          move.w  ZHIGH(a6), d0  ;
  353.        asgnlp:
  354.          move.b  (a0)+, (a1)+   ; ein Zeichen kopieren
  355.          dbeq    d0, asgnlp     ; B: Quelle noch nicht vollstaendig kopiert
  356.          beq.s   voll           ; Zielstring ist schon mit 0C abgeschlossen
  357.          move.l  a0, d2         ; wird oefter gebraucht
  358.          movea.l quelle(a6), a2 ; d2 := Anzahl kopierter Zeichen( = Index )
  359.          sub.l   a2, d2         ;
  360.          cmp.w   QHIGH(a6), d2  ; Index > HIGH(quelle) ?
  361.          bhi.s   tsteos         ; B: ja, Quelle vollstaendig kopiert
  362.          tst.b   (a0)           ; hinter dem letzten kopierten Zeichen  EOS  ?
  363.          bne.s   ende           ; B: nein, dann Quelle nicht vollst. kopiert
  364.        tsteos:
  365.          cmp.w   ZHIGH(a6), d2  ; Ist im Zielstring noch Platz fuer Nullbyte ?
  366.          bhi.s   voll           ; B: nein, Ziel voll
  367.          clr.b   (a1)           ;
  368.        voll:
  369.          moveq   #1, d1
  370.        ende:
  371.          movea.l vollst(a6), a0 ; vollst VAR-Parameter !
  372.          move.b  d1, (a0)       ; vollst setzen
  373. *)
  374.        INLINE( 7200H,206EH,0016H,226EH,0010H,302EH,001AH,0B06EH,0014H );
  375.        INLINE( 6304H,302EH,0014H,12D8H,57C8H,0FFFCH,671AH,2408H,246EH );
  376.        INLINE( 0016H,948AH,0B46EH,001AH,6204H,4A10H,660AH,0B46EH,0014H );
  377.        INLINE( 6202H,4211H,7201H,206EH,000CH,1081H );
  378.  
  379.      END  Assign;
  380.  
  381. (* ------------------------------------------------------------------------- *)
  382.  
  383.   PROCEDURE  Concat ((* EIN/ -- *)     quelle1,
  384.                      (* EIN/ -- *)     quelle2 : ARRAY OF CHAR;
  385.                      (* -- /AUS *) VAR ziel    : ARRAY OF CHAR;
  386.                      (* -- /AUS *) VAR vollst  : BOOLEAN       );
  387. (*T*)
  388.     (* das gleiche wie "Assign", nur zweimal  *)
  389.  
  390. (*   VAR  Index1,
  391.           Index2,
  392.           MaxIndex : INTEGER;  (* kann auch negativ werden *) *)
  393.  
  394.      BEGIN
  395. (*     IF  HIGH( quelle1 ) >  HIGH( ziel )  THEN
  396.           MaxIndex := HIGH( ziel );
  397.        ELSE
  398.           MaxIndex := HIGH( quelle1 );
  399.        END;
  400.  
  401.        Index1 := 0;
  402.        WHILE ( Index1 <= MaxIndex ) & ( quelle1[ Index1 ] # EOS )  DO
  403.           ziel[ Index1 ] := quelle1[ Index1 ];
  404.           INC( Index1 );
  405.        END;
  406.  
  407.        (* Index1 = Anzahl der bisher kopierten Zeichen *)
  408.  
  409.        IF  HIGH( quelle2 ) > ( HIGH( ziel ) - Index1 )  THEN
  410.           MaxIndex := HIGH( ziel ) - Index1;
  411.  
  412.           (* Falls der Zielstring schon durch die erste Quelle vollstaendig
  413.            * belegt ist, gilt:   MaxIndex = -1   , und die zweite Zuwei-
  414.            * sungsschleife wird nicht mehr ausgefuehrt.
  415.            *)
  416.        ELSE
  417.           MaxIndex := HIGH( quelle2 );
  418.        END; (* IF *)
  419.  
  420.  
  421.        Index2 := 0;
  422.        WHILE ( Index2 <= MaxIndex ) & ( quelle2[ Index2 ] # EOS )  DO
  423.  
  424.           ziel[ Index1 ] := quelle2[ Index2 ];
  425.           INC( Index1 );
  426.           INC( Index2 );
  427.        END;
  428.  
  429.        IF  ( Index2 >  HIGH( quelle2 )) OR ( quelle2[ Index2 ] = EOS )  THEN
  430.           vollst := TRUE;
  431.           IF  Index1 <= HIGH( ziel )  THEN
  432.              ziel[ Index1 ] := EOS;
  433.           END;
  434.        ELSE
  435.           vollst := FALSE;
  436.        END;
  437.  
  438.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  439.  
  440.        vollst  EQU  12
  441.        ziel    EQU  vollst + 4
  442.        ZHIGH   EQU  ziel + 4
  443.        quelle2 EQU  ZHIGH + 2
  444.        Q2HIGH  EQU  quelle2 + 4
  445.        quelle1 EQU  Q2HIGH + 2
  446.        Q1HIGH  EQU  quelle1 + 4
  447.  
  448.        Concat:
  449.          moveq   #0, d1
  450.          movea.l quelle1(a6), a0  ; a0 -> quelle, lokale Variable
  451.          movea.l ziel(a6), a1     ; a1 -> ziel
  452.          move.w  Q1HIGH(a6), d0   ; d0 := MIN( HIGH(quelle1), HIGH(ziel) )
  453.          cmp.w   ZHIGH(a6), d0    ;
  454.          bls.s   cnct1lp          ;
  455.          move.w  ZHIGH(a6), d0    ;
  456.        cnct1lp:
  457.          move.b  (a0)+, (a1)+     ; ein Zeichen kopieren
  458.          dbeq    d0, cnct1lp      ; B: Quelle noch nicht vollstaendig kopiert
  459.          bne.s   clccnt           ; B: <quelle1> war mit dem Feldende zuende
  460.                                   ;    oder <ziel>, aber in diesem Fall wird
  461.                                   ;    sowieso nichts mehr gemacht
  462.          subq.l  #1, a1           ; sonst muss Nullbyte entfernt werden
  463.        clccnt:
  464.          move.l  a1, d2           ; wird oefter gebraucht
  465.          movea.l quelle2(a6), a0  ; a0 -> <quelle2>
  466.          movea.l ziel(a6), a2     ; d2 := Anzahl kopierter Zeichen( = Index1 )
  467.          sub.l   a2, d2           ;
  468.          move.w  ZHIGH(a6), d0    ; d0 := noch freie Zeichen in <ziel> - 1
  469.          sub.w   d2, d0
  470.          bcs.s   tstvoll          ; B: <ziel> ist schon voll
  471.          cmp.w   Q2HIGH(a6), d0
  472.          bls.s   cnct2lp
  473.          move.w  Q2HIGH(a6), d0
  474.        cnct2lp:
  475.          move.b  (a0)+, (a1)+     ; ein Zeichen kopieren
  476.          dbeq    d0, cnct2lp      ; B: Quelle noch nicht vollstaendig kopiert
  477.          beq.s   voll
  478.          move.l  a0, d2
  479.          movea.l quelle2(a6), a2
  480.          sub.l   a2, d2
  481.          cmp.w   Q2HIGH(a6), d2   ; Index > HIGH(quelle2) ?
  482.          bhi.s   tsteos           ; B: ja, Quelle vollstaendig kopiert
  483.        tstvoll:
  484.          tst.b   (a0)             ; hinter dem letzten kopierten Zeichen  EOS  ?
  485.          bne.s   ende             ; B: nein, dann Quelle nicht vollst. kopiert
  486.        tsteos:
  487.          move.l  a1, d2
  488.          movea.l ziel(a6), a2
  489.          sub.l   a2, d2
  490.          cmp.w   ZHIGH(a6), d2    ; Ist im Zielstring noch Platz fuer Nullbyte ?
  491.          bhi.s   voll             ; B: nein, Ziel voll
  492.          clr.b   (a1)             ;
  493.        voll:
  494.          moveq   #1, d1
  495.        ende:
  496.          movea.l vollst(a6), a0   ; vollst VAR-Parameter !
  497.          move.b  d1, (a0)         ; vollst setzen
  498.  
  499. *)
  500.        INLINE( 7200H,206EH,001CH,226EH,0010H,302EH,0020H,0B06EH,0014H );
  501.        INLINE( 6304H,302EH,0014H,12D8H,57C8H,0FFFCH,6602H,5389H,2409H );
  502.        INLINE( 206EH,0016H,246EH,0010H,948AH,302EH,0014H,9042H,6520H );
  503.        INLINE( 0B06EH,001AH,6304H,302EH,001AH,12D8H,57C8H,0FFFCH,6722H );
  504.        INLINE( 2408H,246EH,0016H,948AH,0B46EH,001AH,6204H,4A10H,6612H );
  505.        INLINE( 2409H,246EH,0010H,948AH,0B46EH,0014H,6202H,4211H,7201H );
  506.        INLINE( 206EH,000CH,1081H );
  507.  
  508.      END  Concat;
  509.  
  510. (* ------------------------------------------------------------------------- *)
  511.  
  512.   PROCEDURE  Delete ((* EIN/AUS *) VAR string : ARRAY OF CHAR;
  513.                      (* EIN/ -- *)     start,
  514.                      (* EIN/ -- *)     laenge : CARDINAL      );
  515. (*T*)
  516. (*   VAR  StringLaenge : CARDINAL; *)
  517.  
  518.      BEGIN
  519. (*     StringLaenge := Length( string );
  520.  
  521.        IF   start > 0  THEN
  522.           DEC( start );
  523.        END;
  524.  
  525.        IF  start < ( MAX(CARDINAL) - laenge )  THEN
  526.           INC( laenge, start );
  527.        ELSE
  528.           (* Abfrage vermeidet Ueberlauf *)
  529.           laenge := MAX(CARDINAL);
  530.        END;
  531.  
  532.        (* <laenge> enthaelt den Index des ersten Zeichens des nach
  533.         * vorne zu verschiebenden Blocks.
  534.         *)
  535.        WHILE  laenge < StringLaenge  DO
  536.           string[ start ] := string[ laenge ];
  537.           INC( start ); INC( laenge );
  538.        END;
  539.  
  540.        IF   start <= VAL( CARDINAL, HIGH( string ))  THEN
  541.           string[ start ] := EOS;
  542.        END;
  543.  
  544.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  545.  
  546.        laenge  EQU  12
  547.        start   EQU  laenge + 2
  548.        string  EQU  start + 2
  549.        HIGH    EQU  string + 4
  550.  
  551.        Delete:
  552.          movea.l string(a6), a0 ; a0 -> <string>
  553.          movea.l a0, a1
  554.          move.w  HIGH(a6), d0   ; d0 := HIGH(string)
  555.          move.w  d0, d2
  556.        lenlp:
  557.          tst.b   (a0)+          ;
  558.          dbeq    d0, lenlp      ;
  559.          sub.w   d0, d2         ; d2 := Length(string)
  560.          move.w  start(a6), d0  ; d0 := <start>
  561.          beq.s   clcidx
  562.          subq.w  #1, d0
  563.        clcidx:
  564.          movea.l a1, a0         ; a0 -> <string>
  565.          adda.w  d0, a1         ; a1 -> string[start]
  566.          add.w   laenge(a6), d0 ; INC(laenge,start)
  567.          bcs.s   exit           ; Ueberlauf, alles ab <start> loeschen
  568.          adda.w  d0, a0         ; a0 -> string[start+laenge]
  569.          sub.w   d0, d2         ; Gibt es noch Zeichen hinter dem zu
  570.                                 ; loeschenden Stringbereich ?
  571.          bls.s   exit           ; B: nein, Stringende bei string[start]
  572.          bra.s   dellp + 2
  573.        dellp:
  574.          move.b  (a0)+, (a1)+
  575.          dbra    d2, dellp
  576.        exit:
  577.          move.l  a1, d2         ; d2 := ZielIndex
  578.          movea.l string(a6), a0 ;
  579.          sub.l   a0, d2         ;
  580.          cmp.w   HIGH(a6), d2   ; Ist im Zielstring noch Platz fuer Nullbyte ?
  581.          bhi.s   ende           ; B: nein, Ziel voll
  582.          clr.b   (a1)           ; <ziel>-Ende kennzeichnen
  583.        ende:
  584. *)
  585.        INLINE( 206EH,0010H,2248H,302EH,0014H,3400H,4A18H,57C8H,0FFFCH );
  586.        INLINE( 9440H,302EH,000EH,6702H,5340H,2049H,0D2C0H,0D06EH,000CH );
  587.        INLINE( 650EH,0D0C0H,9440H,6308H,6002H,12D8H,51CAH,0FFFCH,2409H );
  588.        INLINE( 206EH,0010H,9488H,0B46EH,0014H,6202H,4211H );
  589.  
  590.      END  Delete;
  591.  
  592. (* ------------------------------------------------------------------------- *)
  593.  
  594.   PROCEDURE  Insert ((* EIN/ -- *)     insert : ARRAY OF CHAR;
  595.                      (* EIN/ -- *)     start  : CARDINAL;
  596.                      (* EIN/AUS *) VAR string : ARRAY OF CHAR;
  597.                      (* -- /AUS *) VAR vollst : BOOLEAN       );
  598. (*T*)
  599.      VAR  Frei,
  600.           StringLaenge,
  601.           InsertLaenge,
  602.           Index        : INTEGER;
  603.  
  604.      BEGIN
  605.        vollst := TRUE;
  606.  
  607.        StringLaenge := Length( string );
  608.        InsertLaenge := Length( insert );
  609.  
  610.        IF   start > 0  THEN
  611.           DEC( start );
  612.           IF   start > VAL( CARDINAL, StringLaenge ) THEN
  613.               start := StringLaenge;      (* <insert> hinten dran  *)
  614.           END;
  615.        END;
  616.        (* 0 <= start <= Length( string )  *)
  617.  
  618.        Frei := HIGH( string ) + 1 - StringLaenge - InsertLaenge;
  619.  
  620.        IF     Frei < 0  THEN
  621.  
  622.        (* ABS( Frei ) enthaelt die Anzahl der Zeichen, die dem
  623.         * Ergebnisstring zum vollstaendigen Ergebnis fehlen.
  624.         *)
  625.  
  626.           INC( StringLaenge, Frei );
  627.  
  628.           (* StringLaenge enthaelt die Anzahl der Zeichen von <string>
  629.            * im Ergebnisstring, falls noch etwas von <string> hinter
  630.            * <insert> steht
  631.            *)
  632.           vollst := FALSE; (* Es passt nicht alles rein *)
  633.  
  634.           IF  HIGH( string ) + 1 - VAL( INTEGER, start )  <  InsertLaenge  THEN
  635.              InsertLaenge := HIGH( string ) + 1 - VAL( INTEGER, start );
  636.           END;
  637.  
  638.           (* InsertLaenge enthaelt die Anzahl der Zeichen von <insert>
  639.            * im Ergebnisstring.
  640.            *)
  641.        ELSIF  Frei > 0  THEN  (* noch zus. Platz fuer Nullbyte *)
  642.           string[ StringLaenge + InsertLaenge ] := EOS;
  643.        END; (* IF  Frei *)
  644.  
  645.        (* Schleife wird nicht ausgefuehrt, falls angefuegt werden soll,
  646.         * oder der zu verschiebende Teil von <string> vollstaendig ausser-
  647.         * halb des Feldes liegt.
  648.         *
  649.         * Wenn man einen Bereich ueberlappend nach 'hinten' kopiert, muss
  650.         * man auch von 'hinten' mit dem Kopieren beginnen, sonst wird dabei
  651.         * die Quelle ueberschrieben. Beim Kopieren nach 'vorne' hingegen,
  652.         * muss man mit dem Anfang beginnen.
  653.         *)
  654.  
  655.         FOR  Index := StringLaenge - 1  TO  VAL( INTEGER, start )  BY  -1   DO
  656.            string[ Index + InsertLaenge ] := string[ Index ];
  657.         END; (* FOR *)
  658.  
  659.         (* <insert> ab <pos> einfuegen *)
  660.  
  661.         FOR  Index := 0  TO  InsertLaenge - 1  DO
  662.            string[ VAL( INTEGER, start ) + Index ] := insert[ Index ];
  663.         END; (* FOR *)
  664.  
  665.      END  Insert;
  666.  
  667. (* ------------------------------------------------------------------------- *)
  668.  
  669.   PROCEDURE  EqualStr ((* EIN/ -- *) string1,
  670.                        (* EIN/ -- *) string2 : ARRAY OF CHAR ): BOOLEAN;
  671. (*T*)
  672. (*   VAR  Index,
  673.           MaxIndex : CARDINAL; *)
  674.  
  675.      BEGIN
  676. (*     Index := 0;
  677.  
  678.        IF      HIGH( string1 )  <  HIGH( string2 )  THEN
  679.            MaxIndex := HIGH( string1 );
  680.        ELSE
  681.            MaxIndex := HIGH( string2 );
  682.        END;
  683.        (* MaxIndex = MIN( HIGH( string1 ), HIGH( string2 ))
  684.         *)
  685.  
  686.        LOOP
  687.          IF    Index > MaxIndex  THEN
  688.             EXIT;
  689.          ELSIF  string1[ Index ] # string2[ Index ]   THEN
  690.             RETURN( FALSE );
  691.  
  692.          ELSIF string1[ Index ] = EOS  THEN
  693.             (* Wenn string1 = 0C, dann auch string2
  694.              *)
  695.             RETURN( TRUE );
  696.          END; (* IF *)
  697.  
  698.          INC( Index );
  699.        END; (* LOOP *)
  700.  
  701.        (* Index = MaxIndex + 1
  702.         *
  703.         * Strings sind auch gleich, falls der eine das ARRAY fuellt
  704.         * und der andere hinter dem letzten verglichenen Zeichen
  705.         * mit "EOS" abgeschlossen ist
  706.         *)
  707.  
  708.        RETURN( NOT (( HIGH( string1 ) < HIGH( string2 )) &
  709.                     ( string2[ Index ] # EOS           )   ) OR
  710.                    (( HIGH( string1 ) > HIGH( string2 )) &
  711.                     ( string1[ Index ] # EOS           )   )    );
  712.  
  713.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  714.  
  715.         string2  EQU  12
  716.         HIGH2    EQU  string2 + 4
  717.         string1  EQU  HIGH2 + 2
  718.         HIGH1    EQU  string1 + 4
  719.         RETURN   EQU  HIGH1 + 2
  720.  
  721.         EqualStr:
  722.           moveq   #0, d2          ; Default: Strings ungleich
  723.           movea.l string1(a6), a0 ; a0 -> string1
  724.           movea.l string2(a6), a1 ; a1 -> string2
  725.           move.w  HIGH1(a6), d0   ; d0 := MIN( HIGH(string1),HIGH(string2))
  726.           cmp.w   HIGH2(a6), d0   ;
  727.           bls.s   eqlp            ;
  728.           move.w  HIGH2(a6), d0   ;
  729.         eqlp:
  730.           move.b  (a0)+, d1       ; Ist naechstes string1-Zeichen = EOS ?
  731.           beq.s   tst2eos         ; B: ja, Schleife zuende und string2-EOS-Test
  732.           cmp.b   (a1)+, d1       ; sonst mit naechstem string2-Zeichen vergl.
  733.           dbne    d0, eqlp        ; B: sind noch gleich und nicht zuende
  734.           bne.s   ende            ; B: unterschiedliches Zeichen entdeckt
  735.           move.w  HIGH1(a6), d0   ; string1-Feld groesser als string2-Feld ?
  736.           cmp.w   HIGH2(a6), d0   ;
  737.           beq.s   true            ; B: sind gleich, also Strings gleich
  738.           blo.s   tst2eos         ; B: nein, kleiner, also string2-Ende-Test
  739.           tst.b   (a0)            ; sonst testen, ob auch string1 zuende
  740.           beq.s   true            ; B: ja, Strings gleich
  741.           bra.s   ende            ; B: string1 nicht zuende -> unterschiedl.
  742.         tst2eos:
  743.           tst.b   (a1)            ; string2 zuende ?
  744.           bne.s   ende            ; B: nein, string2 laenger -> ungleich
  745.         true:
  746.           moveq   #1, d2
  747.         ende:
  748.           move.b  d2, RETURN(a6)
  749. *)
  750.         INLINE( 7400H,206EH,0012H,226EH,000CH,302EH,0016H,0B06EH,0010H );
  751.         INLINE( 6304H,302EH,0010H,1218H,671AH,0B219H,56C8H,0FFF8H,6618H );
  752.         INLINE( 302EH,0016H,0B06EH,0010H,670CH,6506H,4A10H,6706H,6006H );
  753.         INLINE( 4A11H,6602H,7401H,1D42H,0018H );
  754.  
  755.      END  EqualStr;
  756.  
  757. (* ------------------------------------------------------------------------- *)
  758.  
  759.   PROCEDURE  EqualCAPStr ((* EIN/ -- *) string1,
  760.                           (* EIN/ -- *) string2 : ARRAY OF CHAR ): BOOLEAN;
  761. (*T*)
  762.     (* Wie "Equal", nur Vergleich mit CAP() *)
  763. (*   VAR  Index,
  764.           MaxIndex : CARDINAL; *)
  765.      BEGIN
  766. (*     Index := 0;
  767.        IF      HIGH( string1 )  <  HIGH( string2 )  THEN
  768.            MaxIndex := HIGH( string1 );
  769.        ELSE
  770.            MaxIndex := HIGH( string2 );
  771.        END;
  772.        LOOP
  773.          IF    Index > MaxIndex  THEN
  774.             EXIT;
  775.          ELSIF CAP( string1[ Index ] ) # CAP( string2[ Index ] )  THEN
  776.             RETURN( FALSE );
  777.          ELSIF string1[ Index ] = EOS  THEN
  778.             RETURN( TRUE );
  779.          END;
  780.          INC( Index );
  781.        END;
  782.        RETURN( NOT (( HIGH( string1 ) < HIGH( string2 )) &
  783.                     ( string2[ Index ] # EOS           )   ) OR
  784.                    (( HIGH( string1 ) > HIGH( string2 )) &
  785.                     ( string1[ Index ] # EOS           )   )    );
  786.  
  787.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  788.  
  789.         string2  EQU  12
  790.         HIGH2    EQU  string2 + 4
  791.         string1  EQU  HIGH2 + 2
  792.         HIGH1    EQU  string1 + 4
  793.         RETURN   EQU  HIGH1 + 2
  794.  
  795.         EqualCAPStr:
  796.           moveq   #0, d2          ; Default: Strings ungleich
  797.           movea.l string1(a6), a0 ; a0 -> string1
  798.           movea.l string2(a6), a1 ; a1 -> string2
  799.           move.w  HIGH1(a6), d0   ; d0 := MIN( HIGH(string1),HIGH(string2))
  800.           cmp.w   HIGH2(a6), d0   ;
  801.           bls.s   eqlp            ;
  802.           move.w  HIGH2(a6), d0   ;
  803.         eqnclp:
  804.           move.b  (a0)+, d1       ; Ist naechstes string1-Zeichen = EOS ?
  805.           beq.s   tst2eos         ; B: ja, Schleife zuende und string2-EOS-Test
  806.           move.b  (a1)+, d3       ; sonst mit naechstem <string2>-Zeichen
  807.           cmp.b   d1, d3          ; vergleichen
  808.           beq.s   lpcnt           ; B: sind gleich, naechstes Zeichen
  809.           andi.b  #%11011111, d1  ; mal probieren ob's an Gross/Klein-
  810.           andi.b  #%11011111, d3  ; schreibung liegt
  811.           cmp.b   d1, d3          ;
  812.           bne.s   ende            ; B: nein, also nicht gleich
  813.           cmpi.b  #'A', d1        ; Konvertierung klein -> gross hat natuer-
  814.                                   ; lich nur Sinn, wenn es sich um Buchstaben
  815.                                   ; handelt
  816.           blo.s   ende            ; B: war kein Buchstabe, also ungleich
  817.           cmpi.b  #'Z', d1
  818.           bhi.s   ende            ; B: kein Buchstabe -> ungleich
  819.         lpcnt:
  820.           dbra    d0, eqnclp      ; B: bisher gleich, noch nicht alle vergl.
  821.           move.w  HIGH1(a6), d0   ; string1-Feld groesser als string2-Feld ?
  822.           cmp.w   HIGH2(a6), d0   ;
  823.           beq.s   true            ; B: sind gleich, also Strings gleich
  824.           blo.s   tst2eos         ; B: nein, kleiner, also string2-Ende-Test
  825.           tst.b   (a0)            ; sonst testen, ob auch string1 zuende
  826.           beq.s   true            ; B: ja, Strings gleich
  827.           bra.s   ende            ; B: string1 nicht zuende -> unterschiedl.
  828.         tst2eos:
  829.           tst.b   (a1)            ; string2 zuende ?
  830.           bne.s   ende            ; B: nein, string2 laenger -> ungleich
  831.         true:
  832.           moveq   #1, d2
  833.         ende:
  834.           move.b  d2, RETURN(a6)
  835. *)
  836.         INLINE( 7400H,206EH,0012H,226EH,000CH,302EH,0016H,0B06EH,0010H );
  837.         INLINE( 6304H,302EH,0010H,1218H,6734H,1619H,0B601H,6718H,0201H );
  838.         INLINE( 00DFH,0203H,00DFH,0B601H,6628H,0C01H,0041H,6522H,0C01H );
  839.         INLINE( 005AH,621CH,51C8H,0FFDCH,302EH,0016H,0B06EH,0010H,670CH );
  840.         INLINE( 6506H,4A10H,6706H,6006H,4A11H,6602H,7401H,1D42H,0018H );
  841.  
  842.      END  EqualCAPStr;
  843.  
  844. (* ------------------------------------------------------------------------- *)
  845.  
  846.   PROCEDURE  Compare ((* EIN/ -- *) string1,
  847.                       (* EIN/ -- *) string2 : ARRAY OF CHAR ): CompareResult;
  848. (*T*)
  849. (*   VAR  Index,
  850.           MaxIndex : CARDINAL;  *)
  851.  
  852.      BEGIN
  853. (*     Index := 0;
  854.  
  855.        IF      HIGH( string1 )  <  HIGH( string2 )  THEN
  856.            MaxIndex := HIGH( string1 );
  857.        ELSE
  858.            MaxIndex := HIGH( string2 );
  859.        END;
  860.        (* MaxIndex = MIN( HIGH( string1 ), HIGH( string2 ))
  861.         *)
  862.  
  863.        LOOP
  864.          IF    Index > MaxIndex  THEN
  865.             EXIT;
  866.          ELSIF string1[ Index ] # string2[ Index ]  THEN
  867.  
  868.             (* Ergebnis aus dem ersten unterschiedlichen Zeichen bilden
  869.              *)
  870.             IF   string1[ Index ] < string2[ Index ]  THEN
  871.                RETURN( less );
  872.             ELSE
  873.                RETURN( greater );
  874.             END;
  875.  
  876.          ELSIF string1[ Index ] = EOS  THEN
  877.             RETURN( equal );
  878.          END; (* IF *)
  879.  
  880.          INC( Index );
  881.        END; (* LOOP *)
  882.  
  883.        (* Index = maxIndex + 1
  884.         *
  885.         * Bis zur Laenge des kuerzeren Strings sind beide gleich, deshalb
  886.         * wird das Vergleichsergebnis jetzt aus den Laengen der beiden
  887.         * Strings gebildet.
  888.         *)
  889.  
  890.        IF      HIGH( string1 ) < HIGH( string2 )  THEN
  891.  
  892.           (* Index <= HIGH( string2 )
  893.            *)
  894.           IF   string2[ Index ] = EOS  THEN
  895.              RETURN( equal );
  896.           ELSE
  897.              RETURN( less );
  898.           END; (* IF string2[ Index ] *)
  899.  
  900.        ELSIF   HIGH( string1 ) > HIGH( string2 )  THEN
  901.  
  902.           (* Index <= HIGH( string1 )
  903.            *)
  904.           IF   string1[ Index ] = EOS  THEN
  905.              RETURN( equal );
  906.           ELSE
  907.              RETURN( greater );
  908.           END; (* IF string1[ Index ] *)
  909.  
  910.        ELSE (* HIGH( string1 ) = HIGH( string2 ) *)
  911.           RETURN( equal );
  912.        END; (* IF HIGH( string1 ) < HIGH( string2 ) *);
  913.  
  914.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  915.  
  916.         string2  EQU  12
  917.         HIGH2    EQU  string2 + 4
  918.         string1  EQU  HIGH2 + 2
  919.         HIGH1    EQU  string1 + 4
  920.         RETURN   EQU  HIGH1 + 2
  921.  
  922.         less     EQU  0
  923.         equal    EQU  1
  924.         greater  EQU  2
  925.  
  926.         Compare:
  927.           moveq   #equal, d2           ; Default: Strings gleich
  928.           movea.l string1(a6), a0      ; a0 -> string1
  929.           movea.l string2(a6), a1      ; a1 -> string2
  930.           move.w  HIGH1(a6), d0        ; d0 := MIN(HIGH(string1),HIGH(string2))
  931.           cmp.w   HIGH2(a6), d0        ;
  932.           bls.s   eqlp                 ;
  933.           move.w  HIGH2(a6), d0        ;
  934.         eqlp:
  935.           move.b  (a0)+, d1            ; naechstes Zeichen von <string1>
  936.           beq.s   tstless              ; B: <string1> zuende
  937.           cmp.b   (a1)+, d1            ; mit <string2> vergleichen
  938.           dbne    d0, eqlp             ; bis ungleiches Zeichen entdeckt
  939.           bhi.s   gr                   ; Zeichen von <string1> ist groesser
  940.           blo.s   ls                   ;           -"-             kleiner
  941.  
  942.         ; Wenn die Zeichen bis zur Laenge des kuerzeren Strings gleich sind,
  943.         ; Ergebnis aus der Laenge der Strings bilden
  944.  
  945.           move.w  HIGH1(a6), d0
  946.           cmp.w   HIGH2(a6), d0
  947.           beq.s   ende                 ; B: Strings sind gleichlang also gleich
  948.           blo.s   tstless              ; B: <string1> zuende
  949.           tst.b   (a0)                 ; <string2> war zuende
  950.           beq.s   ende                 ; B: <string1> auch, also gleich
  951.         gr:
  952.           moveq   #greater, d2         ; sonst <string1> groesser, da laenger
  953.           bra.s   ende
  954.         tstless:
  955.           tst.b   (a1)                 ; ist <string2> auch zuende ?
  956.           beq.s   ende                 ; B: ja, Strings gleich
  957.         ls:
  958.           moveq   #less, d2            ; sonst <strings> kleiner, da kuerzer
  959.         ende:
  960.           move.b  d2, RETURN(a6)
  961. *)
  962.         INLINE( 7401H,206EH,0012H,226EH,000CH,302EH,0016H,0B06EH,0010H );
  963.         INLINE( 6304H,302EH,0010H,1218H,671EH,0B219H,56C8H,0FFF8H,6212H );
  964.         INLINE( 6518H,302EH,0016H,0B06EH,0010H,6710H,6508H,4A10H,670AH );
  965.         INLINE( 7402H,6006H,4A11H,6702H,7400H,1D42H,0018H );
  966.  
  967.      END  Compare;
  968.  
  969. (* ------------------------------------------------------------------------- *)
  970.  
  971.   PROCEDURE  LeftPos ((* EIN/ -- *) muster : ARRAY OF CHAR;
  972.                       (* EIN/ -- *) start  : CARDINAL;
  973.                       (* EIN/ -- *) string : ARRAY OF CHAR;
  974.                       (* EIN/ -- *) links  : BOOLEAN       ): CARDINAL;
  975. (*T*)
  976.      VAR  Versuche,
  977.           MusterLaenge,
  978.           StringLaenge,
  979.           MusterIndex  : CARDINAL;
  980.  
  981.      BEGIN
  982.        MusterLaenge := Length( muster );
  983.        StringLaenge := Length( string );
  984.  
  985.        IF  start > 0  THEN
  986.           DEC( start );
  987.        END;
  988.  
  989.        IF   ( MusterLaenge = 0                        )  OR
  990.             ( MusterLaenge > ( MAX(CARDINAL) - start ))  OR
  991.             ((  start + MusterLaenge ) > StringLaenge )
  992.        THEN
  993.           (* Bei arithmetischem Ueberlauf von <start> + <MusterLaenge>
  994.            * kann das Muster auch nicht in <string> auftreten
  995.            *)
  996.           RETURN( 0 );
  997.        ELSE
  998.           Versuche := StringLaenge - MusterLaenge - start;
  999.  
  1000.           (* Sooft muss das Muster maximal - um eine Position nach rechts
  1001.            * versetzt - erneut mit dem String verglichen werden. Wenn dann noch
  1002.            * keine Uebereinstimmung festgestellt wurde, ist <muster> nicht
  1003.            * enthalten, da der Reststring kuerzer als <muster> ist.
  1004.            *)
  1005.        END;
  1006.  
  1007.        LOOP
  1008.          MusterIndex := 0;
  1009.  
  1010.          (* Bis zum Musterende oder dem ersten unterschiedlichen Zeichen
  1011.           * suchen
  1012.           *)
  1013.          WHILE  ( MusterIndex < MusterLaenge              )  &
  1014.                 ( string[ start ] = muster[ MusterIndex ] )
  1015.          DO
  1016.             INC( start );
  1017.             INC( MusterIndex );
  1018.          END; (* WHILE *)
  1019.  
  1020.          DEC( start, MusterIndex );
  1021.  
  1022.          IF    MusterIndex = MusterLaenge  THEN
  1023.  
  1024.          (* Bis zum Ende von <muster> stimmt alles ueberein,
  1025.           * also gefunden
  1026.           *)
  1027.             IF   links  THEN
  1028.                RETURN( start + 1 );
  1029.             ELSE
  1030.                RETURN( StringLaenge - start );
  1031.             END;
  1032.          END; (* IF  MusterIndex *)
  1033.  
  1034.          IF  Versuche = 0  THEN
  1035.             RETURN( 0 );
  1036.          END;
  1037.  
  1038.          INC( start );   (* eins weiter rechts versuchen *)
  1039.          DEC( Versuche );
  1040.  
  1041.        END; (* LOOP *)
  1042.  
  1043.      END  LeftPos;
  1044.  
  1045. (* ------------------------------------------------------------------------- *)
  1046.  
  1047.   PROCEDURE  RightPos ((* EIN/ -- *)     muster : ARRAY OF CHAR;
  1048.                        (* EIN/ -- *)     start  : CARDINAL;
  1049.                        (* EIN/ -- *)     string : ARRAY OF CHAR;
  1050.                        (* EIN/ -- *)     links  : BOOLEAN       ): CARDINAL;
  1051. (*T*)
  1052.      VAR  MusterLaenge,
  1053.           StringLaenge,
  1054.           MusterIndex  : CARDINAL;
  1055.  
  1056.      BEGIN
  1057.        MusterLaenge := Length( muster );
  1058.        StringLaenge := Length( string );
  1059.  
  1060.        IF  ( MusterLaenge = 0 )  OR  ( StringLaenge = 0 )  OR
  1061.            ( MusterLaenge > StringLaenge )
  1062.        THEN
  1063.           RETURN( 0 );
  1064.        END;
  1065.  
  1066.        IF  ( start = 0 )  OR  ( start > StringLaenge - MusterLaenge )  THEN
  1067.  
  1068.           (* Soweit hinten wie sinnvoll mit der Suche beginnen, d.h. es
  1069.            * muessen mindestens Length( string ) Zeichen mit dem String
  1070.            * verglichen werden koennen.
  1071.            *)
  1072.           start := StringLaenge - MusterLaenge;
  1073.        ELSE
  1074.           DEC( start );
  1075.        END;
  1076.  
  1077.        LOOP
  1078.          MusterIndex := 0;
  1079.  
  1080.          WHILE  ( MusterIndex < MusterLaenge              )  &
  1081.                 ( string[ start ] = muster[ MusterIndex ] )
  1082.          DO
  1083.             INC( start );
  1084.             INC( MusterIndex );
  1085.          END; (* WHILE *)
  1086.  
  1087.          DEC( start, MusterIndex );
  1088.  
  1089.          IF    MusterIndex = MusterLaenge  THEN  (* gefunden *)
  1090.             IF   links  THEN
  1091.                RETURN( start + 1 );
  1092.             ELSE
  1093.                RETURN( StringLaenge - start );
  1094.             END;
  1095.          END; (* IF  MusterIndex *)
  1096.  
  1097.          IF  start = 0  THEN
  1098.             RETURN( 0 );
  1099.          END;
  1100.  
  1101.          DEC( start );
  1102.        END; (* LOOP *)
  1103.  
  1104.      END  RightPos;
  1105.  
  1106. (* ------------------------------------------------------------------------- *)
  1107.  
  1108.   PROCEDURE  LeftStr ((* EIN/ -- *)     quelle : ARRAY OF CHAR;
  1109.                       (* EIN/ -- *)     anzahl : CARDINAL;
  1110.                       (* -- /AUS *) VAR ziel   : ARRAY OF CHAR;
  1111.                       (* -- /AUS *) VAR vollst : BOOLEAN       );
  1112. (*T*)
  1113. (*   VAR  Index,
  1114.           MaxIndex : INTEGER; (* MaxIndex evtl. = -1 *)  *)
  1115.  
  1116.      BEGIN
  1117. (*     IF   anzahl > VAL( CARDINAL, HIGH( quelle ))  THEN
  1118.           (* Mehr als den Quellstring kann man nicht kopieren
  1119.            *)
  1120.           anzahl := HIGH( quelle ) + 1;
  1121.        END;
  1122.  
  1123.        IF  anzahl  >  VAL( CARDINAL, HIGH( ziel ))  THEN
  1124.           (* Der Zielstring kann nicht soviel aufnehmen
  1125.            *)
  1126.           MaxIndex := HIGH( ziel );
  1127.        ELSE
  1128.           MaxIndex := VAL( INTEGER, anzahl ) - 1;
  1129.  
  1130.           (* Falls <anzahl> gleich Null ist, wird die Schleife
  1131.            * nicht durchlaufen.
  1132.            *)
  1133.        END;
  1134.  
  1135.        Index := 0;
  1136.        WHILE ( Index <= MaxIndex ) & ( quelle[ Index ] # EOS )  DO
  1137.  
  1138.           ziel[ Index ] := quelle[ Index ];
  1139.           INC( Index );
  1140.        END;
  1141.  
  1142.        IF   ( Index = VAL( INTEGER, anzahl )) OR
  1143.             ( quelle[ Index ] = EOS         )
  1144.        THEN
  1145.           vollst := TRUE;
  1146.           IF  Index <= HIGH( ziel )  THEN
  1147.              ziel[ Index ] := EOS;
  1148.           END;
  1149.        ELSE
  1150.           vollst := FALSE;
  1151.        END;
  1152.  
  1153.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1154.  
  1155.        vollst  EQU  12
  1156.        ziel    EQU  vollst + 4
  1157.        ZHIGH   EQU  ziel + 4
  1158.        anzahl  EQU  ZHIGH + 2
  1159.        quelle  EQU  anzahl + 2
  1160.        QHIGH   EQU  quelle + 4
  1161.  
  1162.        LeftStr:
  1163.          moveq   #0, d1
  1164.          movea.l quelle(a6), a0 ; a0 -> quelle, lokale Variable
  1165.          movea.l ziel(a6), a1   ; a1 -> ziel
  1166.          move.w  anzahl(a6), d0
  1167.          beq.s   exit           ; B: anzahl = 0 gibt Leerstring
  1168.          subq.w  #1, d0         ; d0 := MIN(anzahl-1,HIGH(quelle))
  1169.          cmp.w   QHIGH(a6), d0  ;
  1170.          bls.s   clcidx         ;    <=> Anzahl-1 Zeichen zu kopieren
  1171.          move.w  QHIGH(a6), d0  ;
  1172.        clcidx:
  1173.          move.w  d0, d3         ; Anzahl-1 fuer spaeteren vollst-Test
  1174.          cmp.w   ZHIGH(a6), d0  ; MaxIndex := MIN(>d0<,HIGH(ziel))
  1175.          bls.s   asgnlp         ;
  1176.          move.w  ZHIGH(a6), d0  ;
  1177.        asgnlp:
  1178.          move.b  (a0)+, (a1)+   ; ein Zeichen kopieren
  1179.          dbeq    d0, asgnlp     ; B: noch nicht max. Anzahl Zeichen kopiert
  1180.          beq.s   voll           ; Zielstring ist schon mit 0C abgeschlossen
  1181.          move.l  a0, d2         ; d2 := Index ( = Anzahl kop. Zeichen )
  1182.          movea.l quelle(a6), a2 ;
  1183.          sub.l   a2, d2         ;
  1184.          cmp.w   d3, d2         ; Index > Anzahl-1 ?
  1185.          bhi.s   tsteos         ; B: ja, benoetigte Anzahl kopiert
  1186.          tst.b   (a0)           ; hinter dem letzten kopierten Zeichen  EOS  ?
  1187.          bne.s   ende           ; B: nein, dann weniger kopiert
  1188.        tsteos:
  1189.          cmp.w   ZHIGH(a6), d2  ; Ist im Zielstring noch Platz fuer Nullbyte ?
  1190.          bhi.s   voll           ; B: nein, Ziel voll
  1191.        exit:
  1192.          clr.b   (a1)           ; <ziel> Ende kennzeichnen
  1193.        voll:
  1194.          moveq   #1, d1         ; <ziel> ist vollstaendig
  1195.        ende:
  1196.          movea.l vollst(a6), a0 ; vollst VAR-Parameter !
  1197.          move.b  d1, (a0)       ; vollst setzen
  1198. *)
  1199.        INLINE( 7200H,206EH,0018H,226EH,0010H,302EH,0016H,6736H,5340H );
  1200.        INLINE( 0B06EH,001CH,6304H,302EH,001CH,3600H,0B06EH,0014H,6304H );
  1201.        INLINE( 302EH,0014H,12D8H,57C8H,0FFFCH,6718H,2408H,246EH,0018H );
  1202.        INLINE( 948AH,0B443H,6204H,4A10H,660AH,0B46EH,0014H,6202H,4211H );
  1203.        INLINE( 7201H,206EH,000CH,1081H );
  1204.  
  1205.      END  LeftStr;
  1206.  
  1207. (* ------------------------------------------------------------------------- *)
  1208.  
  1209.   PROCEDURE  RightStr ((* EIN/ -- *)     quelle : ARRAY OF CHAR;
  1210.                        (* EIN/ -- *)     anzahl : CARDINAL;
  1211.                        (* -- /AUS *) VAR ziel   : ARRAY OF CHAR;
  1212.                        (* -- /AUS *) VAR vollst : BOOLEAN       );
  1213. (*T*)
  1214. (*   VAR  QuellIndex  : CARDINAL;
  1215.           ZielIndex,
  1216.           MaxIndex    : INTEGER;    (* MaxIndex evtl. = -1 *) *)
  1217.  
  1218.      BEGIN
  1219. (*     QuellIndex := Length( quelle );
  1220.  
  1221.        IF   anzahl > QuellIndex  THEN
  1222.           (* <quelle> hat nur <QuellIndex> Zeichen
  1223.            *)
  1224.           anzahl := QuellIndex;
  1225.        END;
  1226.  
  1227.        IF  anzahl > VAL( CARDINAL, HIGH( ziel ))  THEN
  1228.           MaxIndex := HIGH( ziel );
  1229.        ELSE
  1230.           MaxIndex := VAL( INTEGER, anzahl ) - 1;
  1231.        END;
  1232.  
  1233.  
  1234.        ZielIndex  := 0;
  1235.        DEC( QuellIndex, anzahl );
  1236.  
  1237.        (* QuellIndex ist der Index des ersten zu
  1238.         * kopierenden Zeichens
  1239.         *)
  1240.  
  1241.        WHILE  ZielIndex <= MaxIndex  DO
  1242.  
  1243.          ziel[ ZielIndex ] := quelle[ QuellIndex ];
  1244.  
  1245.          INC( ZielIndex );
  1246.          INC( QuellIndex );
  1247.        END;
  1248.  
  1249.        IF  VAL( CARDINAL, ZielIndex ) = anzahl  THEN
  1250.           (* die gewuenschte Anzahl Zeichen wurde kopiert
  1251.            *)
  1252.           vollst := TRUE;
  1253.           IF  ZielIndex <= HIGH( ziel )  THEN
  1254.              ziel[ ZielIndex ] := EOS;
  1255.           END;
  1256.        ELSE
  1257.           vollst := FALSE;
  1258.        END;
  1259.  
  1260.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1261.  
  1262.        vollst  EQU  12
  1263.        ziel    EQU  vollst + 4
  1264.        ZHIGH   EQU  ziel + 4
  1265.        anzahl  EQU  ZHIGH + 2
  1266.        quelle  EQU  anzahl + 2
  1267.        QHIGH   EQU  quelle + 4
  1268.  
  1269.        RightStr:
  1270.          moveq   #0, d1
  1271.          movea.l quelle(a6), a0 ; a0 -> quelle, lokale Variable
  1272.          movea.l ziel(a6), a1   ; a1 -> ziel
  1273.          move.w  QHIGH(a6), d0  ;
  1274.          move.w  d0, d2
  1275.        lenlp:
  1276.          tst.b   (a0)+          ;
  1277.          dbeq    d0, lenlp      ;
  1278.          sub.w   d0, d2         ; d2 := Length( quelle ) = QuellIndex
  1279.          beq.s   exit           ; QuellLaenge = Null ergibt Leerstring
  1280.          move.w  anzahl(a6), d0
  1281.          beq.s   exit           ; B: anzahl = 0 gibt auch Leerstring
  1282.          cmp.w   d2, d0         ; d0 := MIN(anzahl,Length(quelle))
  1283.          bls.s   clcidx         ;
  1284.          move.w  d2, d0         ;   <=> Anzahl Zeichen zu kopieren
  1285.        clcidx:
  1286.          move.w  d0, d3         ; fuer spaeteren vollst-Test merken
  1287.          sub.w   d0, d2         ; DEC(QuellIndex,anzahl)
  1288.          subq.w  #1, d0         ; >d0<+1 Zeichen zu kopieren
  1289.          cmp.w   ZHIGH(a6), d0  ; MaxIndex := MIN(>d0<,HIGH(ziel))
  1290.          bls.s   clcstart
  1291.          move.w  ZHIGH(a6), d0  ; >d0<+1 Zeichen zu kopieren
  1292.        clcstart:
  1293.          movea.l quelle(a6), a0
  1294.          adda.w  d2, a0         ; a0 -> quelle[ start ]
  1295.        asgnlp:
  1296.          move.b  (a0)+, (a1)+   ; ein Zeichen kopieren
  1297.          dbra    d0, asgnlp     ; B: noch nicht max. moegliche Anzahl kopiert
  1298.          move.l  a1, d2         ; d2 := ZielIndex
  1299.          movea.l ziel(a6), a2   ;
  1300.          sub.l   a2, d2         ;
  1301.          cmp.w   d3, d2         ; ZielIndex = anzahl ?
  1302.          blo.s   ende           ; B: nein, benoetigte Anzahl nicht kopiert
  1303.        tsteos:
  1304.          cmp.w   ZHIGH(a6), d2  ; Ist im Zielstring noch Platz fuer Nullbyte ?
  1305.          bhi.s   voll           ; B: nein, Ziel voll
  1306.        exit:
  1307.          clr.b   (a1)           ; <ziel>-Ende kennzeichnen
  1308.        voll:
  1309.          moveq   #1, d1         ; <ziel> ist vollstaendig
  1310.        ende:
  1311.          movea.l vollst(a6), a0 ; vollst VAR-Parameter !
  1312.          move.b  d1, (a0)       ; vollst setzen
  1313. *)
  1314.        INLINE( 7200H,206EH,0018H,226EH,0010H,302EH,001CH,3400H,4A18H );
  1315.        INLINE( 57C8H,0FFFCH,9440H,673AH,302EH,0016H,6734H,0B042H,6302H );
  1316.        INLINE( 3002H,3600H,9440H,5340H,0B06EH,0014H,6304H,302EH,0014H );
  1317.        INLINE( 206EH,0018H,0D0C2H,12D8H,51C8H,0FFFCH,2409H,246EH,0010H );
  1318.        INLINE( 948AH,0B443H,650AH,0B46EH,0014H,6202H,4211H,7201H,206EH );
  1319.        INLINE( 000CH,1081H );
  1320.  
  1321.      END  RightStr;
  1322.  
  1323. (* ------------------------------------------------------------------------- *)
  1324.  
  1325.   PROCEDURE  SubStr ((* EIN/ -- *)     quelle : ARRAY OF CHAR;
  1326.                      (* EIN/ -- *)     start  : CARDINAL;
  1327.                      (* EIN/ -- *)     laenge : CARDINAL;
  1328.                      (* -- /AUS *) VAR ziel   : ARRAY OF CHAR;
  1329.                      (* -- /AUS *) VAR vollst : BOOLEAN       );
  1330. (*T*)
  1331. (*   VAR  QuellLaenge,
  1332.           Anzahl     : CARDINAL;
  1333.           ZielIndex,
  1334.           MaxIndex   : INTEGER;  *)
  1335.  
  1336.      BEGIN
  1337. (*     QuellLaenge := Length( quelle );
  1338.  
  1339.        IF  start > 0  THEN
  1340.           DEC( start );
  1341.        END;
  1342.  
  1343.        IF  ( laenge > ( MAX(CARDINAL) - start ))  OR  (* Ueberlauf *)
  1344.            (( start + laenge ) > QuellLaenge   )
  1345.        THEN
  1346.           (* Der Substring liegt teilweise oder ganz ausserhalb
  1347.            * von <string>, <Anzahl> enthaelt die Anzahl Zeichen
  1348.            * von <start> bis zum Ende von <quelle>, die als Teilstring
  1349.            * in Frage kommen. Ist <Anzahl> negativ, wird die
  1350.            * Zuweisungsschleife nicht durchlaufen, und <ziel>
  1351.            * wird zum Leerstring.
  1352.            *)
  1353.           IF  start < QuellLaenge  THEN
  1354.              Anzahl := QuellLaenge -  start;
  1355.           ELSE
  1356.              Anzahl := 0;
  1357.           END;
  1358.        ELSE
  1359.           Anzahl := laenge;
  1360.        END; (* IF laenge > *)
  1361.  
  1362.        IF   Anzahl  > VAL( CARDINAL, HIGH( ziel ))  THEN
  1363.           (* Der Zielstring kann nicht soviel aufnehmen
  1364.            *)
  1365.           MaxIndex := HIGH( ziel );
  1366.        ELSE
  1367.           MaxIndex := VAL( INTEGER, Anzahl - 1 );
  1368.        END; (* IF Anzahl > *)
  1369.  
  1370.        ZielIndex := 0;
  1371.        WHILE  ZielIndex <= MaxIndex   DO
  1372.           ziel[ ZielIndex ] := quelle[ start ];
  1373.           INC( ZielIndex );
  1374.           INC( start );
  1375.        END;
  1376.  
  1377.        IF   VAL( CARDINAL, ZielIndex ) >= Anzahl  THEN
  1378.           vollst := TRUE;
  1379.           IF  ZielIndex <= HIGH( ziel )  THEN
  1380.              ziel[ ZielIndex ] := EOS;
  1381.           END;
  1382.        ELSE
  1383.           vollst := FALSE;
  1384.        END;
  1385.  
  1386.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1387.  
  1388.        vollst  EQU  12
  1389.        ziel    EQU  vollst + 4
  1390.        ZHIGH   EQU  ziel + 4
  1391.        laenge  EQU  ZHIGH + 2
  1392.        start   EQU  laenge + 2
  1393.        quelle  EQU  start + 2
  1394.        QHIGH   EQU  quelle + 4
  1395.  
  1396.        SubStr:
  1397.          moveq   #0, d4
  1398.          movea.l quelle(a6), a0 ; a0 -> quelle, lokale Variable
  1399.          movea.l ziel(a6), a1   ; a1 -> ziel
  1400.          move.w  QHIGH(a6), d0  ;
  1401.          move.w  d0, d2
  1402.        lenlp:
  1403.          tst.b   (a0)+          ;
  1404.          dbeq    d0, lenlp      ;
  1405.          sub.w   d0, d2         ; d2 := Length( quelle ) = QuellIndex
  1406.          move.w  start(a6), d0
  1407.          beq.s   clcanz         ; <start> = 0 <=> <start> = 1
  1408.          subq.w  #1, d0         ; DEC(start)
  1409.        clcanz:
  1410.          move.w  d0, d1         ; d1 := start
  1411.          move.w  d0, d3         ; d3 := start
  1412.          add.w   laenge(a6), d0
  1413.          bcs.s   tststart       ; B: Ueberlauf, auch groesser
  1414.          cmp.w   d2, d0         ; start+laenge > QuellLaenge ?
  1415.          bls.s   passt          ; B: nein, <laenge> passt
  1416.        tststart:
  1417.          cmp.w   d2, d1         ; start >= QuellLaenge ?
  1418.          bhs.s   exit           ; B: ja, ergibt Nullstring
  1419.          sub.w   d1, d2         ; d2 := QuellLaenge - start ( > 0 )
  1420.          bra.s   clcmax
  1421.        passt:
  1422.          move.w  laenge(a6), d2 ; Anzahl := laenge
  1423.          beq.s   exit
  1424.        clcmax:
  1425.          move.w  d2, d1         ; Anzahl fuer vollst-Test merken
  1426.          subq.w  #1, d2         ;
  1427.          cmp.w   ZHIGH(a6), d2  ;
  1428.          bls.s   clcidx         ;
  1429.          move.w  ZHIGH(a6), d2  ; d2:=MIN(Anzahl-1,HIGH(ziel)) = MaxIndex >= 0
  1430.        clcidx:
  1431.          movea.l quelle(a6), a0 ;
  1432.          adda.w  d3, a0         ; a0 := quelle[start]
  1433.        loop:
  1434.          move.b  (a0)+, (a1)+   ; ein Zeichen kopieren
  1435.          dbra    d2, loop       ; B: noch nicht max. Anzahl Zeichen kopiert
  1436.          move.l  a1, d2         ; d2 := ZielIndex
  1437.          movea.l ziel(a6), a2   ;
  1438.          sub.l   a2, d2         ;
  1439.          cmp.w   d1, d2         ; ZielIndex = anzahl ?
  1440.          blo.s   ende           ; B: nein, benoetigte Anzahl nicht kopiert
  1441.        tsteos:
  1442.          cmp.w   ZHIGH(a6), d2  ; Ist im Zielstring noch Platz fuer Nullbyte ?
  1443.          bhi.s   voll           ; B: nein, Ziel voll
  1444.        exit:
  1445.          clr.b   (a1)           ; <ziel>-Ende kennzeichnen
  1446.        voll:
  1447.          moveq   #1, d4         ; <ziel> ist vollstaendig
  1448.        ende:
  1449.          movea.l vollst(a6), a0 ; vollst VAR-Parameter !
  1450.          move.b  d4, (a0)       ; vollst setzen
  1451. *)
  1452.        INLINE( 7800H,206EH,001AH,226EH,0010H,302EH,001EH,3400H,4A18H );
  1453.        INLINE( 57C8H,0FFFCH,9440H,302EH,0018H,6702H,5340H,3200H,3600H );
  1454.        INLINE( 0D06EH,0016H,6504H,0B042H,6308H,0B242H,6436H,9441H,6006H );
  1455.        INLINE( 342EH,0016H,672CH,3202H,5342H,0B46EH,0014H,6304H,342EH );
  1456.        INLINE( 0014H,206EH,001AH,0D0C3H,12D8H,51CAH,0FFFCH,2409H,246EH );
  1457.        INLINE( 0010H,948AH,0B441H,650AH,0B46EH,0014H,6202H,4211H,7801H );
  1458.        INLINE( 206EH,000CH,1084H );
  1459.  
  1460.      END  SubStr;
  1461.  
  1462. (* ------------------------------------------------------------------------- *)
  1463.  
  1464.   PROCEDURE  CAPStr ((* EIN/ -- *)     quelle : ARRAY OF CHAR;
  1465.                      (* -- /AUS *) VAR ziel   : ARRAY OF CHAR;
  1466.                      (* -- /AUS *) VAR vollst : BOOLEAN       );
  1467. (*T*)
  1468.      (* Wie "Assign", nur ein CAP in der Zuweisung *)
  1469.  
  1470. (*   VAR  Index,
  1471.           MaxIndex : CARDINAL; *)
  1472.  
  1473.      BEGIN
  1474. (*     IF  HIGH( quelle )  >  HIGH( ziel )  THEN
  1475.           MaxIndex := HIGH( ziel );
  1476.        ELSE
  1477.           MaxIndex := HIGH( quelle );
  1478.        END;
  1479.  
  1480.        Index := 0;
  1481.        WHILE ( Index <= MaxIndex ) & ( quelle[ Index ] # EOS )  DO
  1482.  
  1483.           ziel[ Index ] := CAP( quelle[ Index ]);
  1484.           INC( Index );
  1485.        END;
  1486.  
  1487.  
  1488.        IF  ( Index > VAL( CARDINAL, HIGH( quelle )))  OR
  1489.            ( quelle[ Index ] = EOS                 )
  1490.        THEN
  1491.           vollst := TRUE;
  1492.           IF  Index <= VAL( CARDINAL, HIGH( ziel ))  THEN
  1493.              ziel[ Index ] := EOS;
  1494.           END;
  1495.        ELSE
  1496.           vollst := FALSE;
  1497.        END;
  1498.  
  1499.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1500.  
  1501.        vollst  EQU  12
  1502.        ziel    EQU  vollst + 4
  1503.        ZHIGH   EQU  ziel + 4
  1504.        quelle  EQU  ZHIGH + 2
  1505.        QHIGH   EQU  quelle + 4
  1506.  
  1507.        CAPStr:
  1508.          moveq   #0, d1
  1509.          movea.l quelle(a6), a0
  1510.          movea.l ziel(a6), a1
  1511.          move.w  QHIGH(a6), d0
  1512.          cmp.w   ZHIGH(a6), d0
  1513.          bls.s   ucslp
  1514.          move.w  ZHIGH(a6), d0
  1515.        ucslp:
  1516.          move.b  (a0)+, d2      ; naechstes Zeichen aus Quellstring holen
  1517.          cmpi.b  #'a', d2       ; wenn Kleinbuchstabe...
  1518.          blo.s   ucschr         ;
  1519.          cmpi.b  #'z', d2       ;
  1520.          bhi.s   ucschr         ;
  1521.          andi.b  #%11011111, d2 ;...dann in Grossbuchstabe wandeln
  1522.        ucschr:
  1523.          move.b  d2, (a1)+      ; Zeichen kopieren
  1524.          dbeq    d0, ucslp
  1525.          beq.s   voll
  1526.          move.l  a0, d2
  1527.          movea.l quelle(a6), a2
  1528.          sub.l   a2, d2
  1529.          cmp.w   QHIGH(a6), d2
  1530.          bhi.s   tsteos
  1531.          tst.b   (a0)
  1532.          bne.s   ende
  1533.        tsteos:
  1534.          cmp.w   ZHIGH(a6), d2
  1535.          bhi.s   voll
  1536.          clr.b   (a1)
  1537.        voll:
  1538.          moveq   #1, d1
  1539.        ende:
  1540.          movea.l vollst(a6), a0
  1541.          move.b  d1, (a0)
  1542. *)
  1543.        INLINE( 7200H,206EH,0016H,226EH,0010H,302EH,001AH,0B06EH,0014H );
  1544.        INLINE( 6304H,302EH,0014H,1418H,0C02H,0061H,650AH,0C02H,007AH );
  1545.        INLINE( 6204H,0202H,00DFH,12C2H,57C8H,0FFEAH,671AH,2408H,246EH );
  1546.        INLINE( 0016H,948AH,0B46EH,001AH,6204H,4A10H,660AH,0B46EH,0014H );
  1547.        INLINE( 6202H,4211H,7201H,206EH,000CH,1081H );
  1548.  
  1549.      END  CAPStr;
  1550.  
  1551. (* ------------------------------------------------------------------------- *)
  1552.  
  1553.   PROCEDURE  CharToStr ((* EIN/ -- *)     zeichen : CHAR;
  1554.                         (* -- /AUS *) VAR string  : ARRAY OF CHAR );
  1555. (*T*)
  1556.      BEGIN
  1557.        string[ 0 ] := zeichen;
  1558.  
  1559.        (* Wenn noch Platz ist, mit Nullbyte abschliessen
  1560.         *)
  1561.        IF  HIGH( string ) > 0  THEN
  1562.           string[ 1 ] := EOS;
  1563.        END;
  1564.      END  CharToStr;
  1565.  
  1566. (* ------------------------------------------------------------------------- *)
  1567.  
  1568.   PROCEDURE  GetChar ((* EIN/ -- *) string : ARRAY OF CHAR;
  1569.                       (* EIN/ -- *) pos    : CARDINAL      ): CHAR;
  1570. (*T*)
  1571. (*   VAR  Index : CARDINAL; *)
  1572.  
  1573.      BEGIN
  1574. (*     IF   ( pos = 0 )  OR  ( pos > VAL( CARDINAL, HIGH( string ) + 1 ))  THEN
  1575.           RETURN( EOS );
  1576.        END;
  1577.  
  1578.        DEC( pos );
  1579.        (* 0 <= pos <= HIGH( string ) *)
  1580.        Index := 0;
  1581.  
  1582.        WHILE  ( string[ Index ] # EOS )  &  ( Index < pos )  DO
  1583.           (* (0<=Index<pos) & ((0<=i<=Index) => (string[i] # EOS ))
  1584.            *)
  1585.           INC( Index );
  1586.        END;
  1587.  
  1588.        (* (Index=pos) OR (string[Index] = EOS)
  1589.         *
  1590.         * Falls 'pos' hinter dem Stringende liegt, wird wegen der
  1591.         * Endemarkierung trotzdem automatisch 'EOS' zurueckgegeben
  1592.         *)
  1593.  
  1594.        RETURN( string[ Index ] );
  1595.  
  1596.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1597.  
  1598.        pos     EQU    12        ; letzter Parameter
  1599.        string  EQU    pos+2
  1600.        HIGH    EQU    string+4
  1601.        RETURN  EQU    HIGH+2
  1602.  
  1603.        GetChar:
  1604.          moveq   #0, d1         ; Default: RETURN = EOS
  1605.          move.w  pos(a6), d0    ;
  1606.          subq.w  #1, d0         ; DEC( pos ) ( pos = 0 ==> pos = MAX( CARD )
  1607.          cmp.w   HIGH(a6), d0   ; pos > HIGH( string )  ?
  1608.          bhi.s   ende           ; B: ja, EOS zurueckgeben
  1609.          movea.l string(a6), a0 ; a0 -> lokale Stringvariable
  1610.        getlp:
  1611.          move.b  (a0)+, d1      ; Position oder Stringende erreicht ?
  1612.          dbeq    d0, getlp      ; B: noch nicht
  1613.        ende:                    ; Zeichen in d1
  1614.          move.b  d1, RETURN(a6) ; Funktionswert uebergeben
  1615. *)
  1616.        INLINE( 7200H,302EH,000CH,5340H,0B06EH,0012H,620AH,206EH,000EH );
  1617.        INLINE( 1218H,57C8H,0FFFCH,1D41H,0014H );
  1618.  
  1619.      END  GetChar;
  1620.  
  1621. (* ------------------------------------------------------------------------- *)
  1622.  
  1623.   PROCEDURE  AssignChar ((* EIN/ -- *)     zeichen: CHAR;
  1624.                          (* EIN/ -- *)     pos    : CARDINAL;
  1625.                          (* EIN/AUS *) VAR string : ARRAY OF CHAR );
  1626. (*T*)
  1627. (*   VAR  Index : CARDINAL; *)
  1628.  
  1629.      BEGIN
  1630. (*
  1631.        IF   ( pos = 0 )  OR  ( pos > VAL( CARDINAL, HIGH( string ) + 1 ))  THEN
  1632.           (* Wenn <pos> ausserhalb des Strings liegt, nichts zuweisen
  1633.            *)
  1634.           RETURN;
  1635.        END;
  1636.  
  1637.        DEC( pos );
  1638.        Index := 0;
  1639.  
  1640.        WHILE  ( string[ Index ] # EOS )  &  ( Index < pos )  DO
  1641.          (* (0<=Index<pos) & ((0<=i<=Index) => (string[i] # EOS))
  1642.           *)
  1643.          INC( Index );
  1644.        END;
  1645.  
  1646.        (* (string[Index] = EOS) OR (Index = pos)
  1647.         *)
  1648.        IF   string[ Index ] # EOS  THEN
  1649.           string[ Index ] := zeichen;
  1650.        END;
  1651.  
  1652.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1653.  
  1654.        string  EQU  12
  1655.        HIGH    EQU  string + 4
  1656.        pos     EQU  HIGH + 2
  1657.        zeichen EQU  pos + 2
  1658.  
  1659.        AssignChar:
  1660.          move.w  pos(a6), d0         ; Index des zu ueberschreibenden Zeichens
  1661.          subq.w  #1, d0              ; Falls pos = 0  =>  pos = MAX(CARDINAL)
  1662.          cmp.w   HIGH(a6), d0        ; Index ausserhalb des Feldes ?
  1663.          bhi.s   ende                ; B: ja, nichts machen
  1664.          movea.l string(a6), a0      ; a0 -> string
  1665.        tstend:
  1666.          tst.b   (a0)+               ; Schleife bis <pos> oder Stringende
  1667.          dbeq    d0, tstend          ; erreicht ist
  1668.          beq.s   ende                ; B: Stringende, nichts machen
  1669.          move.b  zeichen(a6), -1(a0) ; sonst Zeichen ueberschreiben
  1670.        ende:
  1671. *)
  1672.        INLINE( 302EH,0012H,5340H,0B06EH,0010H,6212H,206EH,000CH,4A18H );
  1673.        INLINE( 57C8H,0FFFCH,6706H,116EH,0014H,0FFFFH );
  1674.  
  1675.      END  AssignChar;
  1676.  
  1677. (* ------------------------------------------------------------------------- *)
  1678.  
  1679.   PROCEDURE  AppendChar ((* EIN/ -- *)     zeichen: CHAR;
  1680.                          (* EIN/AUS *) VAR string : ARRAY OF CHAR;
  1681.                          (* -- /AUS *) VAR vollst : BOOLEAN       );
  1682. (*T*)
  1683. (*   VAR  Laenge : CARDINAL; *)
  1684.  
  1685.      BEGIN
  1686. (*     vollst := TRUE;
  1687.        Laenge := 0;
  1688.  
  1689.        (* Erst mal das Ende des Strings suchen
  1690.         *)
  1691.        WHILE  ( Laenge <= VAL( CARDINAL, HIGH( string )))  &
  1692.               ( string[ Laenge ] # EOS                  )
  1693.        DO
  1694.           INC( Laenge );
  1695.        END;
  1696.  
  1697.        IF  Laenge <= VAL( CARDINAL, HIGH( string ))  THEN
  1698.  
  1699.           (* Es ist noch Platz fuer das anzuhaengende Zeichen
  1700.            *)
  1701.           string[ Laenge ] := zeichen;
  1702.  
  1703.           IF   Laenge < VAL( CARDINAL, HIGH( string ))  THEN
  1704.              (* Es ist sogar noch Platz fuer das abschliessende
  1705.               * Nullbyte
  1706.               *)
  1707.              string[ Laenge + 1 ] := EOS;
  1708.           END;
  1709.        ELSIF  zeichen # 0C  THEN
  1710.           (* Ein Nullbyte braucht keinen Platz, da es nicht
  1711.            * zum String gehoert, sondern sein Ende kennzeichnet;
  1712.            * Ist <string> also voll und soll ein Nullbyte an-
  1713.            * gehaengt werden, so ist der String trotzdem vollstaendig
  1714.            *)
  1715.           vollst := FALSE;
  1716.        END; (* IF *)
  1717.  
  1718.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1719.  
  1720.        vollst  EQU  12
  1721.        string  EQU  vollst + 4
  1722.        HIGH    EQU  string + 4
  1723.        zeichen EQU  HIGH + 2
  1724.  
  1725.        AppendChar:
  1726.          movea.l string(a6), a0
  1727.          move.w  HIGH(a6), d0
  1728.          moveq   #1, d1              ; Default: vollst = FALSE
  1729.          tst.b   zeichen(a6)         ; Ist <zeichen> ein Nullbyte ?
  1730.          beq.s   ende                ; B: ja, wird ignoriert
  1731.        lenlp:
  1732.          tst.b   (a0)+               ; Stringende erreicht ?
  1733.          dbeq    d0, lenlp           ; B: nein
  1734.          bne.s   false               ; B: ja, aber kein Platz mehr
  1735.          move.b  zeichen(a6), -1(a0) ; Nullbyte ueberschreiben
  1736.          tst.w   d0                  ; Noch Platz fuer neues Nullbyte ?
  1737.          beq.s   ende                ; B: nein
  1738.          clr.b   (a0)                ; Nullbyte anfuegen
  1739.          bra.s   ende
  1740.        false:
  1741.          moveq   #0, d1
  1742.        ende:
  1743.          movea.l vollst(a6), a0      ; <vollst> setzen
  1744.          move.b  d1, (a0)
  1745. *)
  1746.        INLINE( 206EH,0010H,302EH,0014H,7201H,4A2EH,0016H,6718H,4A18H );
  1747.        INLINE( 57C8H,0FFFCH,660EH,116EH,0016H,0FFFFH,4A40H,6706H,4210H );
  1748.        INLINE( 6002H,7200H,206EH,000CH,1081H );
  1749.  
  1750.     END  AppendChar;
  1751.  
  1752. (* ------------------------------------------------------------------------- *)
  1753.  
  1754.   PROCEDURE  DeleteChar ((* EIN/AUS *) VAR string : ARRAY OF CHAR;
  1755.                          (* EIN/ -- *)     pos    : CARDINAL      );
  1756. (*T*)
  1757. (*   VAR  StringLaenge,
  1758.           Index        : CARDINAL; *)
  1759.  
  1760.      BEGIN
  1761. (*     StringLaenge := Length( string );
  1762.  
  1763.        IF  StringLaenge = 0  THEN
  1764.           (* Hier kann nichts geloescht werden
  1765.            *)
  1766.           RETURN
  1767.        END;
  1768.  
  1769.        IF   ( 0 < pos )  &  ( pos < StringLaenge )  THEN
  1770.  
  1771.           FOR  Index := pos  TO  StringLaenge - 1  DO
  1772.              (* (pos<=Index<StringLaenge                   ) &
  1773.               * ((pos<=i<Index) => (string[i-1] = string[i])
  1774.               *)
  1775.              string[ Index - 1 ] := string[ Index ];
  1776.           END; (* FOR *)
  1777.  
  1778.           (* (pos<=i<StringLaenge) => (string[i-1] = string[i])
  1779.            *)
  1780.  
  1781.        END; (* IF *)
  1782.  
  1783.        string[ StringLaenge - 1 ] := EOS;
  1784.  
  1785.        (* Endekennung ohne Abfrage, da der String immer um
  1786.         * ein Zeichen kuerzer wird.
  1787.         * Falls <pos> ausserhalb von  <string> liegt,
  1788.         * wird dabei gleich der letzte Buchstabe geloescht
  1789.         *)
  1790.  
  1791.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1792.  
  1793.        pos    EQU  12
  1794.        string EQU  pos + 2
  1795.        HIGH   EQU  string + 4
  1796.  
  1797.        DeleteChar:
  1798.          movea.l string(a6), a0  ; a0 -> <string>
  1799.          move.w  HIGH(a6), d0    ; d0 := HIGH(string)
  1800.          move.w  d0, d2
  1801.        lenlp:                    ; d2 := Length(string)
  1802.          tst.b   (a0)+           ;
  1803.          dbeq    d0, lenlp       ;
  1804.          sub.w   d0, d2          ;
  1805.          beq.s   ende            ; Es gibt nichts zu loeschen
  1806.          movea.l string(a6), a1  ; damit steht a1 auf dem letzten Zeichen
  1807.          adda.w  d2, a1          ; falls nur das letzte Zeichen geloescht
  1808.          subq.l  #1, a1          ; werden soll
  1809.          move.w  pos(a6), d0     ; d0 := <pos>
  1810.          beq.s   eos             ; B: letztes Zeichen loeschen
  1811.          cmp.w   d2, d0          ; pos >= StringLaenge ?
  1812.          bhs.s   eos             ; B: ja, auch letztes Zeichen loeschen
  1813.          movea.l string(a6), a0
  1814.          adda.w  d0, a0          ; Start mit <string[<pos>]
  1815.          movea.l a0, a1          ; Ziel ist ein Zeichen vorher
  1816.          subq.l  #1, a1          ;
  1817.          sub.w   d0, d2          ; Anzahl zu verschiebender Zeichen
  1818.          bra.s   dellp + 2
  1819.        dellp:                    ; ab <pos> <string> um ein Zeichen nach vorne
  1820.          move.b  (a0)+, (a1)+    ; schieben, zuletzt steht a1 auf dem letzten
  1821.          dbra    d2, dellp       ; Zeichen des urspruenglichen Strings
  1822.        eos:
  1823.          clr.b   (a1)            ; und dort ist jetzt das Stringende
  1824.        ende:
  1825. *)
  1826.        INLINE( 206EH,000EH,302EH,0012H,3400H,4A18H,57C8H,0FFFCH,9440H );
  1827.        INLINE( 6728H,226EH,000EH,0D2C2H,5389H,302EH,000CH,6718H,0B042H );
  1828.        INLINE( 6414H,206EH,000EH,0D0C0H,2248H,5389H,9440H,6002H,12D8H );
  1829.        INLINE( 51CAH,0FFFCH,4211H );
  1830.  
  1831.      END  DeleteChar;
  1832.  
  1833. (* ------------------------------------------------------------------------- *)
  1834.  
  1835.   PROCEDURE  InsertChar ((* EIN/ -- *)     zeichen: CHAR;
  1836.                          (* EIN/ -- *)     pos    : CARDINAL;
  1837.                          (* EIN/AUS *) VAR string : ARRAY OF CHAR;
  1838.                          (* -- /AUS *) VAR vollst : BOOLEAN       );
  1839. (*T*)
  1840. (*   VAR  StringLaenge,
  1841.           Frei,
  1842.           Index        : INTEGER; *)
  1843.  
  1844.      BEGIN
  1845. (*     vollst := TRUE;
  1846.  
  1847.        IF  zeichen = 0C  THEN
  1848.           (* Einen String kann mit "LeftString" gekuerzt werden
  1849.            * oder mit "AssignChar" wenns denn unbedingt sein muss
  1850.            *)
  1851.           RETURN;
  1852.        END;
  1853.  
  1854.        StringLaenge := Length( string );
  1855.  
  1856.        IF  pos > 0  THEN
  1857.           DEC( pos );
  1858.           IF  pos > VAL( CARDINAL, StringLaenge )  THEN
  1859.              pos := StringLaenge        (* Zeichen wird angehaengt *)
  1860.           END;
  1861.        END;
  1862.  
  1863.        Frei := HIGH( string ) - StringLaenge;
  1864.  
  1865.        IF    Frei = -1   THEN
  1866.           vollst := FALSE;
  1867.  
  1868.           IF  pos = VAL( CARDINAL, StringLaenge )  THEN
  1869.              (* <zeichen> geht verloren
  1870.               *)
  1871.              RETURN;
  1872.           ELSE
  1873.              (* letztes Zeichen von <string>geht verloren
  1874.               *)
  1875.              DEC( StringLaenge );
  1876.           END; (* IF pos *)
  1877.  
  1878.        ELSIF Frei >= 1  THEN     (* Platz fuer Nullbyte *)
  1879.           string[ StringLaenge + 1 ] := EOS;
  1880.        END;
  1881.  
  1882.        FOR  Index := StringLaenge - 1 TO  VAL( INTEGER, pos )  BY  -1  DO
  1883.  
  1884.           (* (StringLaenge>Index>=pos                            ) &
  1885.            * ((StringLaenge>i>Index) => (string[i+1] = string[i]))
  1886.            *)
  1887.           string[ Index + 1 ] := string[ Index ];
  1888.        END;
  1889.        (* (StringLaenge>i>=pos) => (string[i+1] = string[i]
  1890.         *)
  1891.  
  1892.        string[ pos ] := zeichen;
  1893.  
  1894.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1895.  
  1896.        vollst  EQU  12
  1897.        string  EQU  vollst + 4
  1898.        HIGH    EQU  string + 4
  1899.        pos     EQU  HIGH + 2
  1900.        zeichen EQU  pos + 2
  1901.  
  1902.        InsertChar:
  1903.          moveq   #1, d3          ; Default: vollstaendig
  1904.          tst.b   zeichen(a6)     ; Ist <zeichen> das Nullbyte ?
  1905.          beq.s   ende            ; B: ja, <string> nicht veraendern
  1906.          movea.l string(a6), a0  ; a0 -> <string>
  1907.          move.w  HIGH(a6), d0    ; d0 := HIGH(string)
  1908.          move.w  d0, d2
  1909.        lenlp:                    ; d2 := Length(string)
  1910.          tst.b   (a0)+           ;
  1911.          dbeq    d0, lenlp       ;
  1912.          sub.w   d0, d2
  1913.                                  ; a0 steht ein Zeichen hinter Feldende
  1914.                                  ; oder dem Nullbyte, falls der String das Feld
  1915.                                  ; nicht ausfuellt
  1916.          move.w  pos(a6), d0     ; d0 := <pos>
  1917.          beq.s   clcfrei         ; B: ist schon kleinster Index
  1918.          subq.w  #1, d0          ; DEC(pos)
  1919.          cmp.w   d2, d0          ; pos > StringLaenge ?
  1920.          bls.s   clcfrei         ; B: nein
  1921.          move.w  d2, d0          ; sonst pos := StringLaenge
  1922.        clcfrei:
  1923.          cmp.w   HIGH(a6), d2    ; d2 = Frei IN {-1,0,+1}
  1924.          beq.s   shift           ; B: Platz reicht, aber nicht fuer EOS
  1925.          bhi.s   short           ; B: Platz reicht nicht
  1926.          clr.b   (a0)            ; sonst schon mal EOS schreiben ( nur wenn
  1927.                                  ; der String das Feld nicht vollstaendig
  1928.                                  ; ausfuellt, sonst wird zu 'short' gesprungen)
  1929.          bra.s   shift
  1930.        short:
  1931.          moveq   #0, d3          ; nicht vollstaendig
  1932.          cmp.w   d2, d0          ; Sollte <zeichen> angehaengt werden ?
  1933.          beq.s   ende            ; B: ja, dafuer ist kein Platz; <string>
  1934.                                  ; wird nicht veraendert
  1935.          subq.w  #1, d2          ; sonst <string> um letztes Zeichen kuerzen
  1936.        shift:
  1937.          movea.l string(a6), a0  ; a0 -> <string>
  1938.          adda.w  d2, a0          ; von hinten verschieben
  1939.          movea.l a0, a1          ; Ziel ist ein Zeichen weiter hinten
  1940.          addq.l  #1, a1          ;
  1941.          sub.w   d0, d2          ; d2:=Anzahl zu kopierender Zeichen
  1942.          bra.s   inslp + 2
  1943.        inslp:
  1944.          move.b  -(a0), -(a1)
  1945.          dbra    d2, inslp
  1946.          move.b  zeichen(a6), (a0)   ; string[pos] := zeichen
  1947.        ende:
  1948.          movea.l vollst(a6), a0
  1949.          move.b  d3, (a0)
  1950. *)
  1951.        INLINE( 7601H,4A2EH,0018H,674CH,206EH,0010H,302EH,0014H,3400H );
  1952.        INLINE( 4A18H,57C8H,0FFFCH,9440H,302EH,0016H,6708H,5340H,0B042H );
  1953.        INLINE( 6302H,3002H,0B46EH,0014H,670EH,6204H,4210H,6008H,7600H );
  1954.        INLINE( 0B042H,671AH,5342H,206EH,0010H,0D0C2H,2248H,5289H,9440H );
  1955.        INLINE( 6002H,1320H,51CAH,0FFFCH,10AEH,0018H,206EH,000CH,1083H );
  1956.  
  1957.      END  InsertChar;
  1958.  
  1959. END  Strings.
  1960.